Theory ODE_Auxiliarities
section ‹Auxiliary Lemmas›
theory ODE_Auxiliarities
imports
"HOL-Analysis.Analysis"
"HOL-Library.Float"
"List-Index.List_Index"
Affine_Arithmetic.Affine_Arithmetic_Auxiliarities
Affine_Arithmetic.Executable_Euclidean_Space
begin
instantiation prod :: (zero_neq_one, zero_neq_one) zero_neq_one
begin
definition "1 = (1, 1)"
instance by standard (simp add: zero_prod_def one_prod_def)
end
subsection ‹there is no inner product for type @{typ "'a ⇒⇩L 'b"}›
lemma (in real_inner) parallelogram_law: "(norm (x + y))⇧2 + (norm (x - y))⇧2 = 2 * (norm x)⇧2 + 2 * (norm y)⇧2"
proof -
have "(norm (x + y))⇧2 + (norm (x - y))⇧2 = inner (x + y) (x + y) + inner (x - y) (x - y)"
by (simp add: norm_eq_sqrt_inner)
also have "… = 2 * (norm x)⇧2 + 2 * (norm y)⇧2"
by (simp add: algebra_simps norm_eq_sqrt_inner)
finally show ?thesis .
qed
locale no_real_inner
begin
lift_definition fstzero::"(real*real) ⇒⇩L (real*real)" is "λ(x, y). (x, 0)"
by (auto intro!: bounded_linearI')
lemma [simp]: "fstzero (a, b) = (a, 0)"
by transfer simp
lift_definition zerosnd::"(real*real) ⇒⇩L (real*real)" is "λ(x, y). (0, y)"
by (auto intro!: bounded_linearI')
lemma [simp]: "zerosnd (a, b) = (0, b)"
by transfer simp
lemma fstzero_add_zerosnd: "fstzero + zerosnd = id_blinfun"
by transfer auto
lemma norm_fstzero_zerosnd: "norm fstzero = 1" "norm zerosnd = 1" "norm (fstzero - zerosnd) = 1"
by (rule norm_blinfun_eqI[where x="(1, 0)"]) (auto simp: norm_Pair blinfun.bilinear_simps
intro: norm_blinfun_eqI[where x="(0, 1)"] norm_blinfun_eqI[where x="(1, 0)"])
text ‹compare with @{thm parallelogram_law}›
lemma "(norm (fstzero + zerosnd))⇧2 + (norm (fstzero - zerosnd))⇧2 ≠
2 * (norm fstzero)⇧2 + 2 * (norm zerosnd)⇧2"
by (simp add: fstzero_add_zerosnd norm_fstzero_zerosnd)
end
subsection ‹Topology›
subsection ‹Vector Spaces›
lemma ex_norm_eq_1: "∃x. norm (x::'a::{real_normed_vector, perfect_space}) = 1"
by (metis vector_choose_size zero_le_one)
subsection ‹Reals›
subsection ‹Balls›
text ‹sometimes @{thm mem_ball} etc. are not good ‹[simp]› rules (although they are often useful):
not sure that inequalities are ``simpler'' than set membership (distorts automatic reasoning
when only sets are involved)›
lemmas [simp del] = mem_ball mem_cball mem_sphere mem_ball_0 mem_cball_0
subsection ‹Boundedness›
lemma bounded_subset_cboxE:
assumes "⋀i. i ∈ Basis ⟹ bounded ((λx. x ∙ i) ` X)"
obtains a b where "X ⊆ cbox a b"
proof -
have "⋀i. i ∈ Basis ⟹ ∃a b. ((λx. x ∙ i) ` X) ⊆ {a..b}"
by (metis box_real(2) box_subset_cbox subset_trans bounded_subset_box_symmetric[OF assms] )
then obtain a b where bnds: "⋀i. i ∈ Basis ⟹ ((λx. x ∙ i) ` X) ⊆ {a i .. b i}"
by metis
then have "X ⊆ {x. ∀i∈Basis. x ∙ i ∈ {a i .. b i}}"
by force
also have "… = cbox (∑i∈Basis. a i *⇩R i) (∑i∈Basis. b i *⇩R i)"
by (auto simp: cbox_def)
finally show ?thesis ..
qed
lemma
bounded_euclideanI:
assumes "⋀i. i ∈ Basis ⟹ bounded ((λx. x ∙ i) ` X)"
shows "bounded X"
proof -
from bounded_subset_cboxE[OF assms] obtain a b where "X ⊆ cbox a b" .
with bounded_cbox show ?thesis by (rule bounded_subset)
qed
subsection ‹Intervals›
notation closed_segment ("(1{_--_})")
notation open_segment ("(1{_<--<_})")
lemma min_zero_mult_nonneg_le: "0 ≤ h' ⟹ h' ≤ h ⟹ min 0 (h * k::real) ≤ h' * k"
by (metis dual_order.antisym le_cases min_le_iff_disj mult_eq_0_iff mult_le_0_iff
mult_right_mono_neg)
lemma max_zero_mult_nonneg_le: "0 ≤ h' ⟹ h' ≤ h ⟹ h' * k ≤ max 0 (h * k::real)"
by (metis dual_order.antisym le_cases le_max_iff_disj mult_eq_0_iff mult_right_mono
zero_le_mult_iff)
lemmas closed_segment_eq_real_ivl = closed_segment_eq_real_ivl
lemma bdd_above_is_intervalI: "bdd_above I" if "is_interval I" "a ≤ b" "a ∈ I" "b ∉ I" for I::"real set"
by (meson bdd_above_def is_interval_1 le_cases that)
lemma bdd_below_is_intervalI: "bdd_below I" if "is_interval I" "a ≤ b" "a ∉ I" "b ∈ I" for I::"real set"
by (meson bdd_below_def is_interval_1 le_cases that)
subsection ‹Extended Real Intervals›
subsection ‹Euclidean Components›
subsection ‹Operator Norm›
subsection ‹Limits›
lemma eventually_open_cball:
assumes "open X"
assumes "x ∈ X"
shows "eventually (λe. cball x e ⊆ X) (at_right 0)"
proof -
from open_contains_cball_eq[OF assms(1)] assms(2)
obtain e where "e > 0" "cball x e ⊆ X" by auto
thus ?thesis
by (auto simp: eventually_at dist_real_def mem_cball intro!: exI[where x=e])
qed
subsection ‹Continuity›
subsection ‹Derivatives›
lemma
if_eventually_has_derivative:
assumes "(f has_derivative F') (at x within S)"
assumes "∀⇩F x in at x within S. P x" "P x" "x ∈ S"
shows "((λx. if P x then f x else g x) has_derivative F') (at x within S)"
using assms(1)
apply (rule has_derivative_transform_eventually)
subgoal using assms(2) by eventually_elim auto
by (auto simp: assms)
lemma norm_le_in_cubeI: "norm x ≤ norm y"
if "⋀i. i ∈ Basis ⟹ abs (x ∙ i) ≤ abs (y ∙ i)" for x y
unfolding norm_eq_sqrt_inner
apply (subst euclidean_inner)
apply (subst (3) euclidean_inner)
using that
by (auto intro!: sum_mono simp: abs_le_square_iff power2_eq_square[symmetric])
lemma has_derivative_partials_euclidean_convexI:
fixes f::"'a::euclidean_space ⇒ 'b::real_normed_vector"
assumes f': "⋀i x xi. i ∈ Basis ⟹ (∀j∈Basis. x ∙ j ∈ X j) ⟹ xi = x ∙ i ⟹
((λp. f (x + (p - x ∙ i) *⇩R i)) has_vector_derivative f' i x) (at xi within X i)"
assumes df_cont: "⋀i. i ∈ Basis ⟹ (f' i ⤏ (f' i x)) (at x within {x. ∀j∈Basis. x ∙ j ∈ X j})"
assumes "⋀i. i ∈ Basis ⟹ x ∙ i ∈ X i"
assumes "⋀i. i ∈ Basis ⟹ convex (X i)"
shows "(f has_derivative (λh. ∑j∈Basis. (h ∙ j) *⇩R f' j x)) (at x within {x. ∀j∈Basis. x ∙ j ∈ X j})"
(is "_ (at x within ?S)")
proof (rule has_derivativeI)
show "bounded_linear (λh. ∑j∈Basis. (h ∙ j) *⇩R f' j x)"
by (auto intro!: bounded_linear_intros)
obtain E where [simp]: "set E = (Basis::'a set)" "distinct E"
using finite_distinct_list[OF finite_Basis] by blast
have [simp]: "length E = DIM('a)"
using ‹distinct E› distinct_card by fastforce
have [simp]: "E ! j ∈ Basis" if "j < DIM('a)" for j
by (metis ‹length E = DIM('a)› ‹set E = Basis› nth_mem that)
have "convex ?S"
by (rule convex_prod) (use assms in auto)
have sum_Basis_E: "sum g Basis = (∑j<DIM('a). g (E ! j))" for g
apply (rule sum.reindex_cong[OF _ _ refl])
apply (auto simp: inj_on_nth)
by (metis ‹distinct E› ‹length E = DIM('a)› ‹set E = Basis› bij_betw_def bij_betw_nth)
have segment: "∀⇩F x' in at x within ?S. x' ∈ ?S" "∀⇩F x' in at x within ?S. x' ≠ x"
unfolding eventually_at_filter by auto
show "((λy. (f y - f x - (∑j∈Basis. ((y - x) ∙ j) *⇩R f' j x)) /⇩R norm (y - x)) ⤏ 0) (at x within {x. ∀j∈Basis. x ∙ j ∈ X j})"
apply (rule tendstoI)
unfolding norm_conv_dist[symmetric]
proof -
fix e::real
assume "e > 0"
define B where "B = e / norm (2*DIM('a) + 1)"
with ‹e > 0› have B_thms: "B > 0" "2 * DIM('a) * B < e" "B ≥ 0"
by (auto simp: divide_simps algebra_simps B_def)
define B' where "B' = B / 2"
have "B' > 0" by (simp add: B'_def ‹0 < B›)
have "∀i ∈ Basis. ∀⇩F xa in at x within {x. ∀j∈Basis. x ∙ j ∈ X j}. dist (f' i xa) (f' i x) < B'"
apply (rule ballI)
subgoal premises prems using df_cont[OF prems, THEN tendstoD, OF ‹0 < B'›] .
done
from eventually_ball_finite[OF finite_Basis this]
have "∀⇩F x' in at x within {x. ∀j∈Basis. x ∙ j ∈ X j}. ∀j∈Basis. dist (f' j x') (f' j x) < B'" .
then obtain d where "d > 0"
and "⋀x' j. x' ∈ {x. ∀j∈Basis. x ∙ j ∈ X j} ⟹ x' ≠ x ⟹ dist x' x < d ⟹ j ∈ Basis ⟹ dist (f' j x') (f' j x) < B'"
using ‹0 < B'›
by (auto simp: eventually_at)
then have B': "x' ∈ {x. ∀j∈Basis. x ∙ j ∈ X j} ⟹ dist x' x < d ⟹ j ∈ Basis ⟹ dist (f' j x') (f' j x) < B'" for x' j
by (cases "x' = x", auto simp add: ‹0 < B'›)
then have B: "norm (f' j x' - f' j y) < B" if
"(⋀j. j ∈ Basis ⟹ x' ∙ j ∈ X j)"
"(⋀j. j ∈ Basis ⟹ y ∙ j ∈ X j)"
"dist x' x < d"
"dist y x < d"
"j ∈ Basis"
for x' y j
proof -
have "dist (f' j x') (f' j x) < B'" "dist (f' j y) (f' j x) < B'"
using that
by (auto intro!: B')
then have "dist (f' j x') (f' j y) < B' + B'" by norm
also have "… = B" by (simp add: B'_def)
finally show ?thesis by (simp add: dist_norm)
qed
have "∀⇩F x' in at x within {x. ∀j∈Basis. x ∙ j ∈ X j}. dist x' x < d"
by (rule tendstoD[OF tendsto_ident_at ‹d > 0›])
with segment
show "∀⇩F x' in at x within {x. ∀j∈Basis. x ∙ j ∈ X j}.
norm ((f x' - f x - (∑j∈Basis. ((x' - x) ∙ j) *⇩R f' j x)) /⇩R norm (x' - x)) < e"
proof eventually_elim
case (elim x')
then have os_subset: "open_segment x x' ⊆ ?S"
using ‹convex ?S› assms(3)
unfolding convex_contains_open_segment
by auto
then have cs_subset: "closed_segment x x' ⊆ ?S"
using elim assms(3) by (auto simp add: open_segment_def)
have csc_subset: "closed_segment (x' ∙ i) (x ∙ i) ⊆ X i" if i: "i ∈ Basis" for i
apply (rule closed_segment_subset)
using cs_subset elim assms(3,4) that
by (auto )
have osc_subset: "open_segment (x' ∙ i) (x ∙ i) ⊆ X i" if i: "i ∈ Basis" for i
using segment_open_subset_closed csc_subset[OF i]
by (rule order_trans)
define h where "h = x' - x"
define z where "z j = (∑k<j. (h ∙ E ! k) *⇩R (E ! k))" for j
define g where "g j t = (f (x + z j + (t - x ∙ E ! j) *⇩R E ! j))" for j t
have z: "z j ∙ E ! j = 0" if "j < DIM('a)" for j
using that
by (auto simp: z_def h_def algebra_simps inner_sum_left inner_Basis if_distrib
nth_eq_iff_index_eq
sum.delta
intro!: euclidean_eqI[where 'a='a]
cong: if_cong)
from distinct_Ex1[OF ‹distinct E›, unfolded ‹set E = Basis› Ex1_def ‹length E = _›]
obtain index where
index: "⋀i. i ∈ Basis ⟹ i = E ! index i" "⋀i. i ∈ Basis ⟹ index i < DIM('a)"
and unique: "⋀i j. i ∈ Basis ⟹ j < DIM('a) ⟹ E ! j = i ⟹ j = index i"
by metis
have nth_eq_iff_index: "E ! k = i ⟷ index i = k" if "i ∈ Basis" "k < DIM('a)" for k i
using unique[OF that] index[OF ‹i ∈ Basis›]
by auto
have z_inner: "z j ∙ i = (if j ≤ index i then 0 else h ∙ i)" if "j < DIM('a)" "i ∈ Basis" for j i
using that index[of i]
by (auto simp: z_def h_def algebra_simps inner_sum_left inner_Basis if_distrib
sum.delta nth_eq_iff_index
intro!: euclidean_eqI[where 'a='a]
cong: if_cong)
have z_mem: "j < DIM('a) ⟹ ja ∈ Basis ⟹ x ∙ ja + z j ∙ ja ∈ X ja" for j ja
using csc_subset
by (auto simp: z_inner h_def algebra_simps)
have "norm (x' - x) < d"
using elim by (simp add: dist_norm)
have norm_z': "y ∈ closed_segment (x ∙ E ! j) (x' ∙ E ! j) ⟹ norm (z j + y *⇩R E ! j - (x ∙ E ! j) *⇩R E ! j) < d"
if "j < DIM('a)"
for j y
apply (rule le_less_trans[OF _ ‹norm (x' - x) < d›])
apply (rule norm_le_in_cubeI)
apply (auto simp: inner_diff_left inner_add_left inner_Basis that z)
subgoal by (auto simp: closed_segment_eq_real_ivl split: if_splits)
subgoal for i
using that
by (auto simp: z_inner h_def algebra_simps)
done
have norm_z: "norm (z j) < d" if "j < DIM('a)" for j
using norm_z'[OF that ends_in_segment(1)]
by (auto simp: z_def)
{
fix j
assume j: "j < DIM('a)"
have eq: "(x + z j + ((y - (x + z j)) ∙ E ! j) *⇩R E ! j +
(p - (x + z j + ((y - (x + z j)) ∙ E ! j) *⇩R E ! j) ∙ E ! j) *⇩R
E ! j) = (x + z j + (p - (x ∙ E ! j)) *⇩R E ! j)" for y p
by (auto simp: algebra_simps j z)
have f_has_derivative: "((λp. f (x + z j + (p - x ∙ E ! j) *⇩R E ! j)) has_derivative (λxa. xa *⇩R f' (E ! j) (x + z j + ((y *⇩R E ! j - (x + z j)) ∙ E ! j) *⇩R E ! j)))
(at y within closed_segment (x ∙ E ! j) (x' ∙ E ! j))"
if "y ∈ closed_segment (x ∙ E ! j) (x' ∙ E ! j)"
for y
apply (rule has_derivative_subset)
apply (rule f'[unfolded has_vector_derivative_def,
where x= "x + z j + ((y *⇩R E!j - (x + z j))∙ E!j) *⇩R E ! j" and i="E ! j", unfolded eq])
subgoal by (simp add: j)
subgoal
using that
apply (auto simp: algebra_simps z j inner_Basis)
using closed_segment_commute ‹E ! j ∈ Basis› csc_subset apply blast
by (simp add: z_mem j)
subgoal by (auto simp: algebra_simps z j inner_Basis)
subgoal
apply (auto simp: algebra_simps z j inner_Basis)
using closed_segment_commute ‹⋀j. j < DIM('a) ⟹ E ! j ∈ Basis› csc_subset j apply blast
done
done
have *: "((xa *⇩R E ! j - (x + z j)) ∙ E ! j) = xa - x ∙ E ! j" for xa
by (auto simp: algebra_simps z j)
have g': "(g j has_vector_derivative (f' (E ! j) (x + z j + (xa - x ∙ E ! j) *⇩R E ! j)))
(at xa within (closed_segment (x∙E!j) (x'∙E!j)))"
(is "(_ has_vector_derivative ?g' j xa) _")
if "xa ∈ closed_segment (x∙E!j) (x'∙E!j)" for xa
using that
by (auto simp: has_vector_derivative_def g_def[abs_def] *
intro!: derivative_eq_intros f_has_derivative[THEN has_derivative_eq_rhs])
define g' where "g' j = ?g' j" for j
with g' have g': "(g j has_vector_derivative g' j t) (at t within closed_segment (x∙E!j) (x'∙E!j))"
if "t ∈ closed_segment (x∙E!j) (x'∙E!j)"
for t
by (simp add: that)
have cont_bound: "⋀y. y∈closed_segment (x ∙ E ! j) (x' ∙ E ! j) ⟹ norm (g' j y - g' j (x ∙ E ! j)) ≤ B"
apply (auto simp add: g'_def j algebra_simps inner_Basis z dist_norm
intro!: less_imp_le B z_mem norm_z norm_z')
using closed_segment_commute ‹⋀j. j < DIM('a) ⟹ E ! j ∈ Basis› csc_subset j apply blast
done
from vector_differentiable_bound_linearization[OF g' order_refl cont_bound ends_in_segment(1)]
have n: "norm (g j (x' ∙ E ! j) - g j (x ∙ E ! j) - (x' ∙ E ! j - x ∙ E ! j) *⇩R g' j (x ∙ E ! j)) ≤ norm (x' ∙ E ! j - x ∙ E ! j) * B"
.
have "z (Suc j) = z j + (x' ∙ E ! j - x ∙ E ! j) *⇩R E ! j"
by (auto simp: z_def h_def algebra_simps)
then have "f (x + z (Suc j)) = f (x + z j + (x' ∙ E ! j - x ∙ E ! j) *⇩R E ! j) "
by (simp add: ac_simps)
with n have "norm (f (x + z (Suc j)) - f (x + z j) - (x' ∙ E ! j - x ∙ E ! j) *⇩R f' (E ! j) (x + z j)) ≤ ¦x' ∙ E ! j - x ∙ E ! j¦ * B"
by (simp add: g_def g'_def)
} note B_le = this
have B': "norm (f' (E ! j) (x + z j) - f' (E ! j) x) ≤ B" if "j < DIM('a)" for j
using that assms(3)
by (auto simp add: algebra_simps inner_Basis z dist_norm ‹0 < d›
intro!: less_imp_le B z_mem norm_z)
have "(∑j≤DIM('a) - 1. f (x + z j) - f (x + z (Suc j))) = f (x + z 0) - f (x + z (Suc (DIM('a) - 1)))"
by (rule sum_telescope)
moreover have "z DIM('a) = h"
using index
by (auto simp: z_def h_def algebra_simps inner_sum_left inner_Basis if_distrib
nth_eq_iff_index
sum.delta
intro!: euclidean_eqI[where 'a='a]
cong: if_cong)
moreover have "z 0 = 0"
by (auto simp: z_def)
moreover have "{..DIM('a) - 1} = {..<DIM('a)}"
using le_imp_less_Suc by fastforce
ultimately have "f x - f (x + h) = (∑j<DIM('a). f (x + z j) - f (x + z (Suc j)))"
by (auto simp: )
then have "norm (f (x + h) - f x - (∑j∈Basis. ((x' - x) ∙ j) *⇩R f' j x)) =
norm(
(∑j<DIM('a). f (x + z (Suc j)) - f (x + z j) - (x' ∙ E ! j - x ∙ E ! j) *⇩R f' (E ! j) (x + z j)) +
(∑j<DIM('a). (x' ∙ E ! j - x ∙ E ! j) *⇩R (f' (E ! j) (x + z j) - f' (E ! j) x)))"
(is "_ = norm (sum ?a ?E + sum ?b ?E)")
by (intro arg_cong[where f=norm]) (simp add: sum_negf sum_subtractf sum.distrib algebra_simps sum_Basis_E)
also have "… ≤ norm (sum ?a ?E) + norm (sum ?b ?E)" by (norm)
also have "norm (sum ?a ?E) ≤ sum (λx. norm (?a x)) ?E"
by (rule norm_sum)
also have "… ≤ sum (λj. norm ¦x' ∙ E ! j - x ∙ E ! j¦ * B) ?E"
by (auto intro!: sum_mono B_le)
also have "… ≤ sum (λj. norm (x' - x) * B) ?E"
apply (rule sum_mono)
apply (auto intro!: mult_right_mono ‹0 ≤ B›)
by (metis (full_types) ‹⋀j. j < DIM('a) ⟹ E ! j ∈ Basis› inner_diff_left norm_bound_Basis_le order_refl)
also have "… = norm (x' - x) * DIM('a) * B"
by simp
also have "norm (sum ?b ?E) ≤ sum (λx. norm (?b x)) ?E"
by (rule norm_sum)
also have "… ≤ sum (λj. norm (x' - x) * B) ?E"
apply (intro sum_mono)
apply (auto intro!: mult_mono B')
apply (metis (full_types) ‹⋀j. j < DIM('a) ⟹ E ! j ∈ Basis› inner_diff_left norm_bound_Basis_le order_refl)
done
also have "… = norm (x' - x) * DIM('a) * B"
by simp
finally have "norm (f (x + h) - f x - (∑j∈Basis. ((x' - x) ∙ j) *⇩R f' j x)) ≤
norm (x' - x) * real DIM('a) * B + norm (x' - x) * real DIM('a) * B"
by arith
also have "… /⇩R norm (x' - x) ≤ norm (2 * DIM('a) * B)"
using ‹B ≥ 0›
by (simp add: divide_simps abs_mult)
also have "… < e" using B_thms by simp
finally show ?case by (auto simp: divide_simps abs_mult h_def)
qed
qed
qed
lemma
frechet_derivative_equals_partial_derivative:
fixes f::"'a::euclidean_space ⇒ 'a"
assumes Df: "⋀x. (f has_derivative Df x) (at x)"
assumes f': "((λp. f (x + (p - x ∙ i) *⇩R i) ∙ b) has_real_derivative f' x i b) (at (x ∙ i))"
shows "Df x i ∙ b = f' x i b"
proof -
define Dfb where "Dfb x = Blinfun (Df x)" for x
have Dfb_apply: "blinfun_apply (Dfb x) = Df x" for x
unfolding Dfb_def
apply (rule bounded_linear_Blinfun_apply)
apply (rule has_derivative_bounded_linear)
apply (rule assms)
done
have "Dfb x = blinfun_of_matrix (λi b. Dfb x b ∙ i)" for x
using blinfun_of_matrix_works[of "Dfb x"] by auto
have Dfb: "⋀x. (f has_derivative Dfb x) (at x)"
by (auto simp: Dfb_apply Df)
note [derivative_intros] = diff_chain_at[OF _ Dfb, unfolded o_def]
have "((λp. f (x + (p - x ∙ i) *⇩R i) ∙ b) has_real_derivative Dfb x i ∙ b) (at (x ∙ i))"
by (auto intro!: derivative_eq_intros ext simp: has_field_derivative_def blinfun.bilinear_simps)
from DERIV_unique[OF f' this]
show ?thesis by (simp add: Dfb_apply)
qed
subsection ‹Integration›
lemmas content_real[simp]
lemmas integrable_continuous[intro, simp]
and integrable_continuous_real[intro, simp]
lemma integral_eucl_le:
fixes f g::"'a::euclidean_space ⇒ 'b::ordered_euclidean_space"
assumes "f integrable_on s"
and "g integrable_on s"
and "⋀x. x ∈ s ⟹ f x ≤ g x"
shows "integral s f ≤ integral s g"
using assms
by (auto intro!: integral_component_le simp: eucl_le[where 'a='b])
lemma
integral_ivl_bound:
fixes l u::"'a::ordered_euclidean_space"
assumes "⋀x h'. h' ∈ {t0 .. h} ⟹ x ∈ {t0 .. h} ⟹ (h' - t0) *⇩R f x ∈ {l .. u}"
assumes "t0 ≤ h"
assumes f_int: "f integrable_on {t0 .. h}"
shows "integral {t0 .. h} f ∈ {l .. u}"
proof -
from assms(1)[of t0 t0] assms(2) have "0 ∈ {l .. u}" by auto
have "integral {t0 .. h} f = integral {t0 .. h} (λt. if t ∈ {t0, h} then 0 else f t)"
by (rule integral_spike[where S="{t0, h}"]) auto
also
{
fix x
assume 1: "x ∈ {t0 <..< h}"
with assms have "(h - t0) *⇩R f x ∈ {l .. u}" by auto
then have "(if x ∈ {t0, h} then 0 else f x) ∈ {l /⇩R (h - t0) .. u /⇩R (h - t0)}"
using ‹x ∈ _›
by (auto simp: inverse_eq_divide
simp: eucl_le[where 'a='a] field_simps algebra_simps)
}
then have "… ∈ {integral {t0..h} (λ_. l /⇩R (h - t0)) .. integral {t0..h} (λ_. u /⇩R (h - t0))}"
unfolding atLeastAtMost_iff
apply (safe intro!: integral_eucl_le)
using ‹0 ∈ {l .. u}›
apply (auto intro!: assms
intro: integrable_continuous_real integrable_spike[where S="{t0, h}", OF f_int]
simp: eucl_le[where 'a='a] divide_simps
split: if_split_asm)
done
also have "… ⊆ {l .. u}"
using assms ‹0 ∈ {l .. u}›
by (auto simp: inverse_eq_divide)
finally show ?thesis .
qed
lemma
add_integral_ivl_bound:
fixes l u::"'a::ordered_euclidean_space"
assumes "⋀x h'. h' ∈ {t0 .. h} ⟹ x ∈ {t0 .. h} ⟹ (h' - t0) *⇩R f x ∈ {l - x0 .. u - x0}"
assumes "t0 ≤ h"
assumes f_int: "f integrable_on {t0 .. h}"
shows "x0 + integral {t0 .. h} f ∈ {l .. u}"
using integral_ivl_bound[OF assms]
by (auto simp: algebra_simps)
subsection ‹conditionally complete lattice›
subsection ‹Lists›
lemma
Ball_set_Cons[simp]: "(∀a∈set_Cons x y. P a) ⟷ (∀a∈x. ∀b∈y. P (a#b))"
by (auto simp: set_Cons_def)
lemma set_cons_eq_empty[iff]: "set_Cons a b = {} ⟷ a = {} ∨ b = {}"
by (auto simp: set_Cons_def)
lemma listset_eq_empty_iff[iff]: "listset XS = {} ⟷ {} ∈ set XS"
by (induction XS) auto
lemma sing_in_sings[simp]: "[x] ∈ (λx. [x]) ` xd ⟷ x ∈ xd"
by auto
lemma those_eq_None_set_iff: "those xs = None ⟷ None ∈ set xs"
by (induction xs) (auto split: option.split)
lemma those_eq_Some_lengthD: "those xs = Some ys ⟹ length xs = length ys"
by (induction xs arbitrary: ys) (auto split: option.splits)
lemma those_eq_Some_map_Some_iff: "those xs = Some ys ⟷ (xs = map Some ys)" (is "?l ⟷ ?r")
proof safe
assume ?l
then have "length xs = length ys"
by (rule those_eq_Some_lengthD)
then show ?r using ‹?l›
by (induction xs ys rule: list_induct2) (auto split: option.splits)
next
assume ?r
then have "length xs = length ys"
by simp
then show "those (map Some ys) = Some ys" using ‹?r›
by (induction xs ys rule: list_induct2) (auto split: option.splits)
qed
subsection ‹Set(sum)›
subsection ‹Max›
subsection ‹Uniform Limit›
subsection ‹Bounded Linear Functions›
lift_definition comp3::
"('c::real_normed_vector ⇒⇩L 'd::real_normed_vector) ⇒ ('b::real_normed_vector ⇒⇩L 'c) ⇒⇩L 'b ⇒⇩L 'd" is
"λ(cd::('c ⇒⇩L 'd)) (bc::'b ⇒⇩L 'c). (cd o⇩L bc)"
by (rule bounded_bilinear.bounded_linear_right[OF bounded_bilinear_blinfun_compose])
lemma blinfun_apply_comp3[simp]: "blinfun_apply (comp3 a) b = (a o⇩L b)"
by (simp add: comp3.rep_eq)
lemma bounded_linear_comp3[bounded_linear]: "bounded_linear comp3"
by transfer (rule bounded_bilinear_blinfun_compose)
lift_definition comp12::
"('a::real_normed_vector ⇒⇩L 'c::real_normed_vector) ⇒ ('b::real_normed_vector ⇒⇩L 'c) ⇒ ('a × 'b) ⇒⇩L 'c"
is "λf g (a, b). f a + g b"
by (auto intro!: bounded_linear_intros
intro: bounded_linear_compose
simp: split_beta')
lemma blinfun_apply_comp12[simp]: "blinfun_apply (comp12 f g) b = f (fst b) + g (snd b)"
by (simp add: comp12.rep_eq split_beta)
subsection ‹Order Transitivity Attributes›
attribute_setup le = ‹Scan.succeed (Thm.rule_attribute [] (fn context => fn thm => thm RS @{thm order_trans}))›
"transitive version of inequality (useful for intro)"
attribute_setup ge = ‹Scan.succeed (Thm.rule_attribute [] (fn context => fn thm => thm RS @{thm order_trans[rotated]}))›
"transitive version of inequality (useful for intro)"
subsection ‹point reflection›
definition preflect::"'a::real_vector ⇒ 'a ⇒ 'a" where "preflect ≡ λt0 t. 2 *⇩R t0 - t"
lemma preflect_preflect[simp]: "preflect t0 (preflect t0 t) = t"
by (simp add: preflect_def algebra_simps)
lemma preflect_preflect_image[simp]: "preflect t0 ` preflect t0 ` S = S"
by (simp add: image_image)
lemma is_interval_preflect[simp]: "is_interval (preflect t0 ` S) ⟷ is_interval S"
by (auto simp: preflect_def[abs_def])
lemma iv_in_preflect_image[intro, simp]: "t0 ∈ T ⟹ t0 ∈ preflect t0 ` T"
by (auto intro!: image_eqI simp: preflect_def algebra_simps scaleR_2)
lemma preflect_tendsto[tendsto_intros]:
fixes l::"'a::real_normed_vector"
shows "(g ⤏ l) F ⟹ (h ⤏ m) F ⟹ ((λx. preflect (g x) (h x)) ⤏ preflect l m) F"
by (auto intro!: tendsto_eq_intros simp: preflect_def)
lemma continuous_preflect[continuous_intros]:
fixes a::"'a::real_normed_vector"
shows "continuous (at a within A) (preflect t0)"
by (auto simp: continuous_within intro!: tendsto_intros)
lemma
fixes t0::"'a::ordered_real_vector"
shows preflect_le[simp]: "t0 ≤ preflect t0 b ⟷ b ≤ t0"
and le_preflect[simp]: "preflect t0 b ≤ t0 ⟷ t0 ≤ b"
and antimono_preflect: "antimono (preflect t0)"
and preflect_le_preflect[simp]: "preflect t0 a ≤ preflect t0 b ⟷ b ≤ a"
and preflect_eq_cancel[simp]: "preflect t0 a = preflect t0 b ⟷ a = b"
by (auto intro!: antimonoI simp: preflect_def scaleR_2)
lemma preflect_eq_point_iff[simp]: "t0 = preflect t0 s ⟷ t0 = s" "preflect t0 s = t0 ⟷ t0 = s"
by (auto simp: preflect_def algebra_simps scaleR_2)
lemma preflect_minus_self[simp]: "preflect t0 s - t0 = t0 - s"
by (simp add: preflect_def scaleR_2)
end
Theory MVT_Ex
theory MVT_Ex
imports
"HOL-Analysis.Analysis"
"HOL-Decision_Procs.Approximation"
"../ODE_Auxiliarities"
begin
subsection ‹(Counter)Example of Mean Value Theorem in Euclidean Space \label{sec:countermvt}›
text ‹There is no exact analogon of the mean value theorem in the multivariate case!›
lemma MVT_wrong: assumes
"⋀J a u (f::real*real⇒real*real).
(⋀x. FDERIV f x :> J x) ⟹
(∃t∈{0<..<1}. f (a + u) - f a = J (a + t *⇩R u) u)"
shows "False"
proof -
have "⋀t::real*real. FDERIV (λt. (cos (fst t), sin (fst t))) t :> (λh. (- ((fst h) * sin (fst t)), (fst h) * cos (fst t)))"
by (auto intro!: derivative_eq_intros)
from assms[OF this, of "(pi, pi)" "(pi, pi)"] obtain t::real where t: "0 < t" "t < 1" and
"pi * sin (t * pi) = 2" "cos (t * pi) = 0"
by auto
then obtain n where tpi: "t * pi = real_of_int n * (pi / 2)" and "odd n"
by (auto simp: cos_zero_iff_int)
then have teq: "t = real_of_int n / 2" by auto
then have "n = 1" using t ‹odd n› by arith
then have "t = 1/2" using teq by simp
have "sin (t * pi) = 1"
by (simp add: ‹t = 1/2› sin_eq_1)
with ‹pi * sin (t * pi) = 2›
have "pi = 2" by simp
moreover have "pi > 2" using pi_approx by simp
ultimately show False by simp
qed
lemma MVT_corrected:
fixes f::"'a::ordered_euclidean_space⇒'b::euclidean_space"
assumes fderiv: "⋀x. x ∈ D ⟹ (f has_derivative J x) (at x within D)"
assumes line_in: "⋀x. ⟦0 ≤ x; x ≤ 1⟧ ⟹ a + x *⇩R u ∈ D"
shows "(∃t∈Basis→{0<..<1}. (f (a + u) - f a) = (∑i∈Basis. (J (a + t i *⇩R u) u ∙ i) *⇩R i))"
proof -
{
fix i::'b
assume "i ∈ Basis"
have subset: "((λx. a + x *⇩R u) ` {0..1}) ⊆ D"
using line_in by force
have "⋀x. ⟦0 ≤ x; x ≤ 1⟧ ⟹ ((λb. f (a + b *⇩R u) ∙ i) has_derivative (λb. b *⇩R J (a + x *⇩R u) u ∙ i)) (at x within {0..1})"
using line_in
by (auto intro!: derivative_eq_intros
has_derivative_subset[OF _ subset]
has_derivative_in_compose[where f="λx. a + x *⇩R u"]
fderiv line_in
simp add: linear.scaleR[OF has_derivative_linear[OF fderiv]])
with zero_less_one
have "∃x∈{0<..<1}. f (a + 1 *⇩R u) ∙ i - f (a + 0 *⇩R u) ∙ i = (1 - 0) *⇩R J (a + x *⇩R u) u ∙ i"
by (rule mvt_simple)
}
then obtain t where "∀i∈Basis. t i ∈ {0<..<1} ∧ f (a + u) ∙ i - f a ∙ i = J (a + t i *⇩R u) u ∙ i"
by atomize_elim (force intro!: bchoice)
hence "t ∈ Basis → {0<..<1}" "⋀i. i ∈ Basis ⟹ (f (a + u) - f a) ∙ i = J (a + t i *⇩R u) u ∙ i"
by (auto simp: inner_diff_left)
moreover hence "(f (a + u) - f a) = (∑i∈Basis. (J (a + t i *⇩R u) u ∙ i) *⇩R i)"
by (intro euclidean_eqI[where 'a='b]) simp
ultimately show ?thesis by blast
qed
lemma MVT_ivl:
fixes f::"'a::ordered_euclidean_space⇒'b::ordered_euclidean_space"
assumes fderiv: "⋀x. x ∈ D ⟹ (f has_derivative J x) (at x within D)"
assumes J_ivl: "⋀x. x ∈ D ⟹ J x u ∈ {J0 .. J1}"
assumes line_in: "⋀x. x ∈ {0..1} ⟹ a + x *⇩R u ∈ D"
shows "f (a + u) - f a ∈ {J0..J1}"
proof -
from MVT_corrected[OF fderiv line_in] obtain t where
t: "t∈Basis → {0<..<1}" and
mvt: "f (a + u) - f a = (∑i∈Basis. (J (a + t i *⇩R u) u ∙ i) *⇩R i)"
by auto
note mvt
also have "… ∈ {J0 .. J1}"
proof -
have J: "⋀i. i ∈ Basis ⟹ J0 ≤ J (a + t i *⇩R u) u"
"⋀i. i ∈ Basis ⟹ J (a + t i *⇩R u) u ≤ J1"
using J_ivl t line_in by (auto simp: Pi_iff)
show ?thesis
using J
unfolding atLeastAtMost_iff eucl_le[where 'a='b]
by auto
qed
finally show ?thesis .
qed
lemma MVT:
shows
"⋀J J0 J1 a u (f::real*real⇒real*real).
(⋀x. FDERIV f x :> J x) ⟹
(⋀x. J x u ∈ {J0 .. J1}) ⟹
f (a + u) - f a ∈ {J0 .. J1}"
by (rule_tac J = J in MVT_ivl[where D=UNIV]) auto
lemma MVT_ivl':
fixes f::"'a::ordered_euclidean_space⇒'b::ordered_euclidean_space"
assumes fderiv: "(⋀x. x ∈ D ⟹ (f has_derivative J x) (at x within D))"
assumes J_ivl: "⋀x. x ∈ D ⟹ J x (a - b) ∈ {J0..J1}"
assumes line_in: "⋀x. x ∈ {0..1} ⟹ b + x *⇩R (a - b) ∈ D"
shows "f a ∈ {f b + J0..f b + J1}"
proof -
have "f (b + (a - b)) - f b ∈ {J0 .. J1}"
using J_ivl MVT_ivl fderiv line_in by blast
thus ?thesis
by (auto simp: diff_le_eq le_diff_eq ac_simps)
qed
end
Theory Vector_Derivative_On
theory
Vector_Derivative_On
imports
"HOL-Analysis.Analysis"
begin
subsection ‹Vector derivative on a set›
definition
has_vderiv_on :: "(real ⇒ 'a::real_normed_vector) ⇒ (real ⇒ 'a) ⇒ real set ⇒ bool"
(infix "(has'_vderiv'_on)" 50)
where
"(f has_vderiv_on f') S ⟷ (∀x ∈ S. (f has_vector_derivative f' x) (at x within S))"
lemma has_vderiv_on_empty[intro, simp]: "(f has_vderiv_on f') {}"
by (auto simp: has_vderiv_on_def)
lemma has_vderiv_on_subset:
assumes "(f has_vderiv_on f') S"
assumes "T ⊆ S"
shows "(f has_vderiv_on f') T"
by (meson assms(1) assms(2) contra_subsetD has_vderiv_on_def has_vector_derivative_within_subset)
lemma has_vderiv_on_compose:
assumes "(f has_vderiv_on f') (g ` T)"
assumes "(g has_vderiv_on g') T"
shows "(f o g has_vderiv_on (λx. g' x *⇩R f' (g x))) T"
using assms
unfolding has_vderiv_on_def
by (auto intro!: vector_diff_chain_within)
lemma has_vderiv_on_open:
assumes "open T"
shows "(f has_vderiv_on f') T ⟷ (∀t ∈ T. (f has_vector_derivative f' t) (at t))"
by (auto simp: has_vderiv_on_def at_within_open[OF _ ‹open T›])
lemma has_vderiv_on_eq_rhs:
"(f has_vderiv_on g') T ⟹ (⋀x. x ∈ T ⟹ g' x = f' x) ⟹ (f has_vderiv_on f') T"
by (auto simp: has_vderiv_on_def)
lemma [THEN has_vderiv_on_eq_rhs, derivative_intros]:
shows has_vderiv_on_id: "((λx. x) has_vderiv_on (λx. 1)) T"
and has_vderiv_on_const: "((λx. c) has_vderiv_on (λx. 0)) T"
by (auto simp: has_vderiv_on_def intro!: derivative_eq_intros)
lemma [THEN has_vderiv_on_eq_rhs, derivative_intros]:
fixes f::"real ⇒ 'a::real_normed_vector"
assumes "(f has_vderiv_on f') T"
shows has_vderiv_on_uminus: "((λx. - f x) has_vderiv_on (λx. - f' x)) T"
using assms
by (auto simp: has_vderiv_on_def intro!: derivative_eq_intros)
lemma [THEN has_vderiv_on_eq_rhs, derivative_intros]:
fixes f g::"real ⇒ 'a::real_normed_vector"
assumes "(f has_vderiv_on f') T"
assumes "(g has_vderiv_on g') T"
shows has_vderiv_on_add: "((λx. f x + g x) has_vderiv_on (λx. f' x + g' x)) T"
and has_vderiv_on_diff: "((λx. f x - g x) has_vderiv_on (λx. f' x - g' x)) T"
using assms
by (auto simp: has_vderiv_on_def intro!: derivative_eq_intros)
lemma [THEN has_vderiv_on_eq_rhs, derivative_intros]:
fixes f::"real ⇒ real" and g::"real ⇒ 'a::real_normed_vector"
assumes "(f has_vderiv_on f') T"
assumes "(g has_vderiv_on g') T"
shows has_vderiv_on_scaleR: "((λx. f x *⇩R g x) has_vderiv_on (λx. f x *⇩R g' x + f' x *⇩R g x)) T"
using assms
by (auto simp: has_vderiv_on_def has_field_derivative_iff_has_vector_derivative
intro!: derivative_eq_intros)
lemma [THEN has_vderiv_on_eq_rhs, derivative_intros]:
fixes f g::"real ⇒ 'a::real_normed_algebra"
assumes "(f has_vderiv_on f') T"
assumes "(g has_vderiv_on g') T"
shows has_vderiv_on_mult: "((λx. f x * g x) has_vderiv_on (λx. f x * g' x + f' x * g x)) T"
using assms
by (auto simp: has_vderiv_on_def intro!: derivative_eq_intros)
lemma has_vderiv_on_ln[THEN has_vderiv_on_eq_rhs, derivative_intros]:
fixes g::"real ⇒ real"
assumes "⋀x. x ∈ s ⟹ 0 < g x"
assumes "(g has_vderiv_on g') s"
shows "((λx. ln (g x)) has_vderiv_on (λx. g' x / g x)) s"
using assms
unfolding has_vderiv_on_def
by (auto simp: has_vderiv_on_def has_field_derivative_iff_has_vector_derivative[symmetric]
intro!: derivative_eq_intros)
lemma fundamental_theorem_of_calculus':
fixes f :: "real ⇒ 'a::banach"
shows "a ≤ b ⟹ (f has_vderiv_on f') {a .. b} ⟹ (f' has_integral (f b - f a)) {a .. b}"
by (auto intro!: fundamental_theorem_of_calculus simp: has_vderiv_on_def)
lemma has_vderiv_on_If:
assumes "U = S ∪ T"
assumes "(f has_vderiv_on f') (S ∪ (closure T ∩ closure S))"
assumes "(g has_vderiv_on g') (T ∪ (closure T ∩ closure S))"
assumes "⋀x. x ∈ closure T ⟹ x ∈ closure S ⟹ f x = g x"
assumes "⋀x. x ∈ closure T ⟹ x ∈ closure S ⟹ f' x = g' x"
shows "((λt. if t ∈ S then f t else g t) has_vderiv_on (λt. if t ∈ S then f' t else g' t)) U"
using assms
by (auto simp: has_vderiv_on_def ac_simps
intro!: has_vector_derivative_If_within_closures
split del: if_split)
lemma mvt_very_simple_closed_segmentE:
fixes f::"real⇒real"
assumes "(f has_vderiv_on f') (closed_segment a b)"
obtains y where "y ∈ closed_segment a b" "f b - f a = (b - a) * f' y"
proof cases
assume "a ≤ b"
with mvt_very_simple[of a b f "λx i. i *⇩R f' x"] assms
obtain y where "y ∈ closed_segment a b" "f b - f a = (b - a) * f' y"
by (auto simp: has_vector_derivative_def closed_segment_eq_real_ivl has_vderiv_on_def)
thus ?thesis ..
next
assume "¬ a ≤ b"
with mvt_very_simple[of b a f "λx i. i *⇩R f' x"] assms
obtain y where "y ∈ closed_segment a b" "f b - f a = (b - a) * f' y"
by (force simp: has_vector_derivative_def has_vderiv_on_def closed_segment_eq_real_ivl algebra_simps)
thus ?thesis ..
qed
lemma mvt_simple_closed_segmentE:
fixes f::"real⇒real"
assumes "(f has_vderiv_on f') (closed_segment a b)"
assumes "a ≠ b"
obtains y where "y ∈ open_segment a b" "f b - f a = (b - a) * f' y"
proof cases
assume "a ≤ b"
with assms have "a < b" by simp
with mvt_simple[of a b f "λx i. i *⇩R f' x"] assms
obtain y where "y ∈ open_segment a b" "f b - f a = (b - a) * f' y"
by (auto simp: has_vector_derivative_def closed_segment_eq_real_ivl has_vderiv_on_def
open_segment_eq_real_ivl)
thus ?thesis ..
next
assume "¬ a ≤ b"
then have "b < a" by simp
with mvt_simple[of b a f "λx i. i *⇩R f' x"] assms
obtain y where "y ∈ open_segment a b" "f b - f a = (b - a) * f' y"
by (force simp: has_vector_derivative_def has_vderiv_on_def closed_segment_eq_real_ivl algebra_simps
open_segment_eq_real_ivl)
thus ?thesis ..
qed
lemma differentiable_bound_general_open_segment:
fixes a :: "real"
and b :: "real"
and f :: "real ⇒ 'a::real_normed_vector"
and f' :: "real ⇒ 'a"
assumes "continuous_on (closed_segment a b) f"
assumes "continuous_on (closed_segment a b) g"
and "(f has_vderiv_on f') (open_segment a b)"
and "(g has_vderiv_on g') (open_segment a b)"
and "⋀x. x ∈ open_segment a b ⟹ norm (f' x) ≤ g' x"
shows "norm (f b - f a) ≤ abs (g b - g a)"
proof -
{
assume "a = b"
hence ?thesis by simp
} moreover {
assume "a < b"
with assms
have "continuous_on {a .. b} f"
and "continuous_on {a .. b} g"
and "⋀x. x∈{a<..<b} ⟹ (f has_vector_derivative f' x) (at x)"
and "⋀x. x∈{a<..<b} ⟹ (g has_vector_derivative g' x) (at x)"
and "⋀x. x∈{a<..<b} ⟹ norm (f' x) ≤ g' x"
by (auto simp: open_segment_eq_real_ivl closed_segment_eq_real_ivl has_vderiv_on_def
at_within_open[where S="{a<..<b}"])
from differentiable_bound_general[OF ‹a < b› this]
have ?thesis by auto
} moreover {
assume "b < a"
with assms
have "continuous_on {b .. a} f"
and "continuous_on {b .. a} g"
and "⋀x. x∈{b<..<a} ⟹ (f has_vector_derivative f' x) (at x)"
and "⋀x. x∈{b<..<a} ⟹ (g has_vector_derivative g' x) (at x)"
and "⋀x. x∈{b<..<a} ⟹ norm (f' x) ≤ g' x"
by (auto simp: open_segment_eq_real_ivl closed_segment_eq_real_ivl has_vderiv_on_def
at_within_open[where S="{b<..<a}"])
from differentiable_bound_general[OF ‹b < a› this]
have "norm (f a - f b) ≤ g a - g b" by simp
also have "… ≤ abs (g b - g a)" by simp
finally have ?thesis by (simp add: norm_minus_commute)
} ultimately show ?thesis by arith
qed
lemma has_vderiv_on_union:
assumes "(f has_vderiv_on g) (s ∪ closure s ∩ closure t)"
assumes "(f has_vderiv_on g) (t ∪ closure s ∩ closure t)"
shows "(f has_vderiv_on g) (s ∪ t)"
unfolding has_vderiv_on_def
proof
fix x assume "x ∈ s ∪ t"
with has_vector_derivative_If_within_closures[of x s t "s ∪ t" f g f g] assms
show "(f has_vector_derivative g x) (at x within s ∪ t)"
by (auto simp: has_vderiv_on_def)
qed
lemma has_vderiv_on_union_closed:
assumes "(f has_vderiv_on g) s"
assumes "(f has_vderiv_on g) t"
assumes "closed s" "closed t"
shows "(f has_vderiv_on g) (s ∪ t)"
using has_vderiv_on_If[OF refl, of f g s t f g] assms
by (auto simp: has_vderiv_on_subset)
lemma vderiv_on_continuous_on: "(f has_vderiv_on f') S ⟹ continuous_on S f"
by (auto intro!: continuous_on_vector_derivative simp: has_vderiv_on_def)
lemma has_vderiv_on_cong[cong]:
assumes "⋀x. x ∈ S ⟹ f x = g x"
assumes "⋀x. x ∈ S ⟹ f' x = g' x"
assumes "S = T"
shows "(f has_vderiv_on f') S = (g has_vderiv_on g') T"
using assms
by (metis has_vector_derivative_transform has_vderiv_on_def)
lemma has_vderiv_eq:
assumes "(f has_vderiv_on f') S"
assumes "⋀x. x ∈ S ⟹ f x = g x"
assumes "⋀x. x ∈ S ⟹ f' x = g' x"
assumes "S = T"
shows "(g has_vderiv_on g') T"
using assms by simp
lemma has_vderiv_on_compose':
assumes "(f has_vderiv_on f') (g ` T)"
assumes "(g has_vderiv_on g') T"
shows "((λx. f (g x)) has_vderiv_on (λx. g' x *⇩R f' (g x))) T"
using has_vderiv_on_compose[OF assms]
by simp
lemma has_vderiv_on_compose2:
assumes "(f has_vderiv_on f') S"
assumes "(g has_vderiv_on g') T"
assumes "⋀t. t ∈ T ⟹ g t ∈ S"
shows "((λx. f (g x)) has_vderiv_on (λx. g' x *⇩R f' (g x))) T"
using has_vderiv_on_compose[OF has_vderiv_on_subset[OF assms(1)] assms(2)] assms(3)
by force
lemma has_vderiv_on_singleton: "(y has_vderiv_on y') {t0}"
by (auto simp: has_vderiv_on_def has_vector_derivative_def has_derivative_within_singleton_iff
bounded_linear_scaleR_left)
lemma
has_vderiv_on_zero_constant:
assumes "convex s"
assumes "(f has_vderiv_on (λh. 0)) s"
obtains c where "⋀x. x ∈ s ⟹ f x = c"
using has_vector_derivative_zero_constant[of s f] assms
by (auto simp: has_vderiv_on_def)
lemma bounded_vderiv_on_imp_lipschitz:
assumes "(f has_vderiv_on f') X"
assumes convex: "convex X"
assumes "⋀x. x ∈ X ⟹ norm (f' x) ≤ C" "0 ≤ C"
shows "C-lipschitz_on X f"
using assms
by (auto simp: has_vderiv_on_def has_vector_derivative_def onorm_scaleR_left onorm_id
intro!: bounded_derivative_imp_lipschitz[where f' = "λx d. d *⇩R f' x"])
end
Theory Interval_Integral_HK
theory Interval_Integral_HK
imports Vector_Derivative_On
begin
subsection ‹interval integral›
definition has_ivl_integral ::
"(real ⇒ 'b::real_normed_vector) ⇒ 'b ⇒ real ⇒ real ⇒ bool"
(infixr "has'_ivl'_integral" 46)
where "(f has_ivl_integral y) a b ⟷ (if a ≤ b then (f has_integral y) {a .. b} else (f has_integral - y) {b .. a})"
definition ivl_integral::"real ⇒ real ⇒ (real ⇒ 'a) ⇒ 'a::real_normed_vector"
where "ivl_integral a b f = integral {a .. b} f - integral {b .. a} f"
lemma integral_emptyI[simp]:
fixes a b::real
shows "a ≥ b ⟹ integral {a..b} f = 0" "a > b ⟹ integral {a..b} f = 0"
by (cases "a = b") auto
lemma ivl_integral_unique: "(f has_ivl_integral y) a b ⟹ ivl_integral a b f = y"
using integral_unique[of f y "{a .. b}"] integral_unique[of f "- y" "{b .. a}"]
unfolding ivl_integral_def has_ivl_integral_def
by (auto split: if_split_asm)
lemma fundamental_theorem_of_calculus_ivl_integral:
fixes f :: "real ⇒ 'a::banach"
shows "(f has_vderiv_on f') (closed_segment a b) ⟹ (f' has_ivl_integral f b - f a) a b"
by (auto simp: has_ivl_integral_def closed_segment_eq_real_ivl intro!: fundamental_theorem_of_calculus')
lemma
fixes f :: "real ⇒ 'a::banach"
assumes "f integrable_on (closed_segment a b)"
shows indefinite_ivl_integral_continuous:
"continuous_on (closed_segment a b) (λx. ivl_integral a x f)"
"continuous_on (closed_segment b a) (λx. ivl_integral a x f)"
using assms
by (auto simp: ivl_integral_def closed_segment_eq_real_ivl split: if_split_asm
intro!: indefinite_integral_continuous_1 indefinite_integral_continuous_1'
continuous_intros intro: continuous_on_eq)
lemma
fixes f :: "real ⇒ 'a::banach"
assumes "f integrable_on (closed_segment a b)"
assumes "c ∈ closed_segment a b"
shows indefinite_ivl_integral_continuous_subset:
"continuous_on (closed_segment a b) (λx. ivl_integral c x f)"
proof -
from assms have "f integrable_on (closed_segment c a)" "f integrable_on (closed_segment c b)"
by (auto simp: closed_segment_eq_real_ivl integrable_on_subinterval
integrable_on_insert_iff split: if_splits)
then have "continuous_on (closed_segment a c ∪ closed_segment c b) (λx. ivl_integral c x f)"
by (auto intro!: indefinite_ivl_integral_continuous continuous_on_closed_Un)
also have "closed_segment a c ∪ closed_segment c b = closed_segment a b"
using assms by (auto simp: closed_segment_eq_real_ivl)
finally show ?thesis .
qed
lemma real_Icc_closed_segment: fixes a b::real shows "a ≤ b ⟹ {a .. b} = closed_segment a b"
by (auto simp: closed_segment_eq_real_ivl)
lemma ivl_integral_zero[simp]: "ivl_integral a a f = 0"
by (auto simp: ivl_integral_def)
lemma ivl_integral_cong:
assumes "⋀x. x ∈ closed_segment a b ⟹ g x = f x"
assumes "a = c" "b = d"
shows "ivl_integral a b f = ivl_integral c d g"
using assms integral_spike[of "{}" "closed_segment a b" f g]
by (auto simp: ivl_integral_def closed_segment_eq_real_ivl split: if_split_asm)
lemma ivl_integral_diff:
"f integrable_on (closed_segment s t) ⟹ g integrable_on (closed_segment s t) ⟹
ivl_integral s t (λx. f x - g x) = ivl_integral s t f - ivl_integral s t g"
using Henstock_Kurzweil_Integration.integral_diff[of f "closed_segment s t" g]
by (auto simp: ivl_integral_def closed_segment_eq_real_ivl split: if_split_asm)
lemma ivl_integral_norm_bound_ivl_integral:
fixes f :: "real ⇒ 'a::banach"
assumes "f integrable_on (closed_segment a b)"
and "g integrable_on (closed_segment a b)"
and "⋀x. x ∈ closed_segment a b ⟹ norm (f x) ≤ g x"
shows "norm (ivl_integral a b f) ≤ abs (ivl_integral a b g)"
using integral_norm_bound_integral[OF assms]
by (auto simp: ivl_integral_def closed_segment_eq_real_ivl split: if_split_asm)
lemma ivl_integral_norm_bound_integral:
fixes f :: "real ⇒ 'a::banach"
assumes "f integrable_on (closed_segment a b)"
and "g integrable_on (closed_segment a b)"
and "⋀x. x ∈ closed_segment a b ⟹ norm (f x) ≤ g x"
shows "norm (ivl_integral a b f) ≤ integral (closed_segment a b) g"
using integral_norm_bound_integral[OF assms]
by (auto simp: ivl_integral_def closed_segment_eq_real_ivl split: if_split_asm)
lemma norm_ivl_integral_le:
fixes f :: "real ⇒ real"
assumes "f integrable_on (closed_segment a b)"
and "g integrable_on (closed_segment a b)"
and "⋀x. x ∈ closed_segment a b ⟹ f x ≤ g x"
and "⋀x. x ∈ closed_segment a b ⟹ 0 ≤ f x"
shows "abs (ivl_integral a b f) ≤ abs (ivl_integral a b g)"
proof (cases "a = b")
case True then show ?thesis
by simp
next
case False
have "0 ≤ integral {a..b} f" "0 ≤ integral {b..a} f"
by (metis le_cases Henstock_Kurzweil_Integration.integral_nonneg assms(1) assms(4) closed_segment_eq_real_ivl integral_emptyI(1))+
then show ?thesis
using integral_le[OF assms(1-3)]
unfolding ivl_integral_def closed_segment_eq_real_ivl
by (simp split: if_split_asm)
qed
lemma ivl_integral_const [simp]:
shows "ivl_integral a b (λx. c) = (b - a) *⇩R c"
by (auto simp: ivl_integral_def algebra_simps)
lemma ivl_integral_has_vector_derivative:
fixes f :: "real ⇒ 'a::banach"
assumes "continuous_on (closed_segment a b) f"
and "x ∈ closed_segment a b"
shows "((λu. ivl_integral a u f) has_vector_derivative f x) (at x within closed_segment a b)"
proof -
have "((λx. integral {x..a} f) has_vector_derivative 0) (at x within {a..b})" if "a ≤ x" "x ≤ b"
by (rule has_vector_derivative_transform) (auto simp: that)
moreover
have "((λx. integral {a..x} f) has_vector_derivative 0) (at x within {b..a})" if "b ≤ x" "x ≤ a"
by (rule has_vector_derivative_transform) (auto simp: that)
ultimately
show ?thesis
using assms
by (auto simp: ivl_integral_def closed_segment_eq_real_ivl
intro!: derivative_eq_intros
integral_has_vector_derivative[of a b f] integral_has_vector_derivative[of b a "-f"]
integral_has_vector_derivative'[of b a f])
qed
lemma ivl_integral_has_vderiv_on:
fixes f :: "real ⇒ 'a::banach"
assumes "continuous_on (closed_segment a b) f"
shows "((λu. ivl_integral a u f) has_vderiv_on f) (closed_segment a b)"
using ivl_integral_has_vector_derivative[OF assms]
by (auto simp: has_vderiv_on_def)
lemma ivl_integral_has_vderiv_on_subset_segment:
fixes f :: "real ⇒ 'a::banach"
assumes "continuous_on (closed_segment a b) f"
and "c ∈ closed_segment a b"
shows "((λu. ivl_integral c u f) has_vderiv_on f) (closed_segment a b)"
proof -
have "(closed_segment c a) ⊆ (closed_segment a b)" "(closed_segment c b) ⊆ (closed_segment a b)"
using assms by (auto simp: closed_segment_eq_real_ivl split: if_splits)
then have "((λu. ivl_integral c u f) has_vderiv_on f) ((closed_segment c a) ∪ (closed_segment c b))"
by (auto intro!: has_vderiv_on_union_closed ivl_integral_has_vderiv_on assms
intro: continuous_on_subset)
also have "(closed_segment c a) ∪ (closed_segment c b) = (closed_segment a b)"
using assms by (auto simp: closed_segment_eq_real_ivl split: if_splits)
finally show ?thesis .
qed
lemma ivl_integral_has_vector_derivative_subset:
fixes f :: "real ⇒ 'a::banach"
assumes "continuous_on (closed_segment a b) f"
and "x ∈ closed_segment a b"
and "c ∈ closed_segment a b"
shows "((λu. ivl_integral c u f) has_vector_derivative f x) (at x within closed_segment a b)"
using ivl_integral_has_vderiv_on_subset_segment[OF assms(1)] assms(2-)
by (auto simp: has_vderiv_on_def)
lemma
compact_interval_eq_Inf_Sup:
fixes A::"real set"
assumes "is_interval A" "compact A" "A ≠ {}"
shows "A = {Inf A .. Sup A}"
apply (auto simp: closed_segment_eq_real_ivl
intro!: cInf_lower cSup_upper bounded_imp_bdd_below bounded_imp_bdd_above
compact_imp_bounded assms)
by (metis assms(1) assms(2) assms(3) cInf_eq_minimum cSup_eq_maximum compact_attains_inf
compact_attains_sup mem_is_interval_1_I)
lemma ivl_integral_has_vderiv_on_compact_interval:
fixes f :: "real ⇒ 'a::banach"
assumes "continuous_on A f"
and "c ∈ A" "is_interval A" "compact A"
shows "((λu. ivl_integral c u f) has_vderiv_on f) A"
proof -
have "A = {Inf A .. Sup A}"
by (rule compact_interval_eq_Inf_Sup) (use assms in auto)
also have "… = closed_segment (Inf A) (Sup A)" using assms
by (auto simp add: closed_segment_eq_real_ivl
intro!: cInf_le_cSup bounded_imp_bdd_below bounded_imp_bdd_above compact_imp_bounded)
finally have *: "A = closed_segment (Inf A) (Sup A)" .
show ?thesis
apply (subst *)
apply (rule ivl_integral_has_vderiv_on_subset_segment)
unfolding *[symmetric]
by fact+
qed
lemma ivl_integral_has_vector_derivative_compact_interval:
fixes f :: "real ⇒ 'a::banach"
assumes "continuous_on A f"
and "is_interval A" "compact A" "x ∈ A" "c ∈ A"
shows "((λu. ivl_integral c u f) has_vector_derivative f x) (at x within A)"
using ivl_integral_has_vderiv_on_compact_interval[OF assms(1)] assms(2-)
by (auto simp: has_vderiv_on_def)
lemma ivl_integral_combine:
fixes f::"real ⇒ 'a::banach"
assumes "f integrable_on (closed_segment a b)"
assumes "f integrable_on (closed_segment b c)"
assumes "f integrable_on (closed_segment a c)"
shows "ivl_integral a b f + ivl_integral b c f = ivl_integral a c f"
proof -
show ?thesis
using assms
Henstock_Kurzweil_Integration.integral_combine[of a b c f]
Henstock_Kurzweil_Integration.integral_combine[of a c b f]
Henstock_Kurzweil_Integration.integral_combine[of b a c f]
Henstock_Kurzweil_Integration.integral_combine[of b c a f]
Henstock_Kurzweil_Integration.integral_combine[of c a b f]
Henstock_Kurzweil_Integration.integral_combine[of c b a f]
by (cases "a ≤ b"; cases "b ≤ c"; cases "a ≤ c")
(auto simp: algebra_simps ivl_integral_def closed_segment_eq_real_ivl)
qed
lemma integral_equation_swap_initial_value:
fixes x::"real⇒'a::banach"
assumes "⋀t. t ∈ closed_segment t0 t1 ⟹ x t = x t0 + ivl_integral t0 t (λt. f t (x t))"
assumes t: "t ∈ closed_segment t0 t1"
assumes int: "(λt. f t (x t)) integrable_on closed_segment t0 t1"
shows "x t = x t1 + ivl_integral t1 t (λt. f t (x t))"
proof -
from t int have "(λt. f t (x t)) integrable_on closed_segment t0 t"
"(λt. f t (x t)) integrable_on closed_segment t t1"
by (auto intro: integrable_on_subinterval simp: closed_segment_eq_real_ivl split: if_split_asm)
with assms(1)[of t] assms(2-)
have "x t - x t0 = ivl_integral t0 t1 (λt. f t (x t)) + ivl_integral t1 t (λt. f t (x t))"
by (subst ivl_integral_combine) (auto simp: closed_segment_commute)
then have "x t + x t1 - (x t0 + ivl_integral t0 t1 (λt. f t (x t))) =
x t1 + ivl_integral t1 t (λt. f t (x t))"
by (simp add: algebra_simps)
also have "x t0 + ivl_integral t0 t1 (λt. f t (x t)) = x t1"
by (auto simp: assms(1)[symmetric])
finally show ?thesis by simp
qed
lemma has_integral_nonpos:
fixes f :: "'n::euclidean_space ⇒ real"
assumes "(f has_integral i) s"
and "∀x∈s. f x ≤ 0"
shows "i ≤ 0"
by (rule has_integral_nonneg[of "-f" "-i" s, simplified])
(auto intro!: has_integral_neg simp: fun_Compl_def assms)
lemma has_ivl_integral_nonneg:
fixes f :: "real ⇒ real"
assumes "(f has_ivl_integral i) a b"
and "⋀x. a ≤ x ⟹ x ≤ b ⟹ 0 ≤ f x"
and "⋀x. b ≤ x ⟹ x ≤ a ⟹ f x ≤ 0"
shows "0 ≤ i"
using assms has_integral_nonneg[of f i "{a .. b}"] has_integral_nonpos[of f "-i" "{b .. a}"]
by (auto simp: has_ivl_integral_def Ball_def not_le split: if_split_asm)
lemma has_ivl_integral_ivl_integral:
"f integrable_on (closed_segment a b) ⟷ (f has_ivl_integral (ivl_integral a b f)) a b"
by (auto simp: closed_segment_eq_real_ivl has_ivl_integral_def ivl_integral_def)
lemma ivl_integral_nonneg:
fixes f :: "real ⇒ real"
assumes "f integrable_on (closed_segment a b)"
and "⋀x. a ≤ x ⟹ x ≤ b ⟹ 0 ≤ f x"
and "⋀x. b ≤ x ⟹ x ≤ a ⟹ f x ≤ 0"
shows "0 ≤ ivl_integral a b f"
by (rule has_ivl_integral_nonneg[OF assms(1)[unfolded has_ivl_integral_ivl_integral] assms(2-3)])
lemma ivl_integral_bound:
fixes f::"real ⇒ 'a::banach"
assumes "continuous_on (closed_segment a b) f"
assumes "⋀t. t ∈ (closed_segment a b) ⟹ norm (f t) ≤ B"
shows "norm (ivl_integral a b f) ≤ B * abs (b - a)"
using integral_bound[of a b f B]
integral_bound[of b a f B]
assms
by (auto simp: closed_segment_eq_real_ivl has_ivl_integral_def ivl_integral_def split: if_splits)
lemma ivl_integral_minus_sets:
fixes f::"real ⇒ 'a::banach"
shows "f integrable_on (closed_segment c a) ⟹ f integrable_on (closed_segment c b) ⟹ f integrable_on (closed_segment a b) ⟹
ivl_integral c a f - ivl_integral c b f = ivl_integral b a f"
using ivl_integral_combine[of f c b a]
by (auto simp: algebra_simps closed_segment_commute)
lemma ivl_integral_minus_sets':
fixes f::"real ⇒ 'a::banach"
shows "f integrable_on (closed_segment a c) ⟹ f integrable_on (closed_segment b c) ⟹ f integrable_on (closed_segment a b) ⟹
ivl_integral a c f - ivl_integral b c f = ivl_integral a b f"
using ivl_integral_combine[of f a b c]
by (auto simp: algebra_simps closed_segment_commute)
end
Theory Gronwall
theory Gronwall
imports Vector_Derivative_On
begin
subsection ‹Gronwall›
lemma derivative_quotient_bound:
assumes g_deriv_on: "(g has_vderiv_on g') {a .. b}"
assumes frac_le: "⋀t. t ∈ {a .. b} ⟹ g' t / g t ≤ K"
assumes g'_cont: "continuous_on {a .. b} g'"
assumes g_pos: "⋀t. t ∈ {a .. b} ⟹ g t > 0"
assumes t_in: "t ∈ {a .. b}"
shows "g t ≤ g a * exp (K * (t - a))"
proof -
have g_deriv: "⋀t. t ∈ {a .. b} ⟹ (g has_real_derivative g' t) (at t within {a .. b})"
using g_deriv_on
by (auto simp: has_vderiv_on_def has_field_derivative_iff_has_vector_derivative[symmetric])
from assms have g_nonzero: "⋀t. t ∈ {a .. b} ⟹ g t ≠ 0"
by fastforce
have frac_integrable: "⋀t. t ∈ {a .. b} ⟹ (λt. g' t / g t) integrable_on {a..t}"
by (force simp: g_nonzero intro: assms has_field_derivative_subset[OF g_deriv]
continuous_on_subset[OF g'_cont] continuous_intros integrable_continuous_real
continuous_on_subset[OF vderiv_on_continuous_on[OF g_deriv_on]])
have "⋀t. t ∈ {a..b} ⟹ ((λt. g' t / g t) has_integral ln (g t) - ln (g a)) {a .. t}"
by (rule fundamental_theorem_of_calculus)
(auto intro!: derivative_eq_intros assms has_field_derivative_subset[OF g_deriv]
simp: has_field_derivative_iff_has_vector_derivative[symmetric])
hence *: "⋀t. t ∈ {a .. b} ⟹ ln (g t) - ln (g a) = integral {a .. t} (λt. g' t / g t)"
using integrable_integral[OF frac_integrable]
by (rule has_integral_unique[where f = "λt. g' t / g t"])
from * t_in have "ln (g t) - ln (g a) = integral {a .. t} (λt. g' t / g t)" .
also have "… ≤ integral {a .. t} (λ_. K)"
using ‹t ∈ {a .. b}›
by (intro integral_le) (auto intro!: frac_integrable frac_le integral_le)
also have "… = K * (t - a)" using ‹t ∈ {a .. b}›
by simp
finally have "ln (g t) ≤ K * (t - a) + ln (g a)" (is "?lhs ≤ ?rhs")
by simp
hence "exp ?lhs ≤ exp ?rhs"
by simp
thus ?thesis
using ‹t ∈ {a .. b}› g_pos
by (simp add: ac_simps exp_add del: exp_le_cancel_iff)
qed
lemma derivative_quotient_bound_left:
assumes g_deriv_on: "(g has_vderiv_on g') {a .. b}"
assumes frac_ge: "⋀t. t ∈ {a .. b} ⟹ K ≤ g' t / g t"
assumes g'_cont: "continuous_on {a .. b} g'"
assumes g_pos: "⋀t. t ∈ {a .. b} ⟹ g t > 0"
assumes t_in: "t ∈ {a..b}"
shows "g t ≤ g b * exp (K * (t - b))"
proof -
have g_deriv: "⋀t. t ∈ {a .. b} ⟹ (g has_real_derivative g' t) (at t within {a .. b})"
using g_deriv_on
by (auto simp: has_vderiv_on_def has_field_derivative_iff_has_vector_derivative[symmetric])
from assms have g_nonzero: "⋀t. t ∈ {a..b} ⟹ g t ≠ 0"
by fastforce
have frac_integrable: "⋀t. t ∈ {a .. b} ⟹ (λt. g' t / g t) integrable_on {t..b}"
by (force simp: g_nonzero intro: assms has_field_derivative_subset[OF g_deriv]
continuous_on_subset[OF g'_cont] continuous_intros integrable_continuous_real
continuous_on_subset[OF vderiv_on_continuous_on[OF g_deriv_on]])
have "⋀t. t ∈ {a..b} ⟹ ((λt. g' t / g t) has_integral ln (g b) - ln (g t)) {t..b}"
by (rule fundamental_theorem_of_calculus)
(auto intro!: derivative_eq_intros assms has_field_derivative_subset[OF g_deriv]
simp: has_field_derivative_iff_has_vector_derivative[symmetric])
hence *: "⋀t. t ∈ {a..b} ⟹ ln (g b) - ln (g t) = integral {t..b} (λt. g' t / g t)"
using integrable_integral[OF frac_integrable]
by (rule has_integral_unique[where f = "λt. g' t / g t"])
have "K * (b - t) = integral {t..b} (λ_. K)"
using ‹t ∈ {a..b}›
by simp
also have "... ≤ integral {t..b} (λt. g' t / g t)"
using ‹t ∈ {a..b}›
by (intro integral_le) (auto intro!: frac_integrable frac_ge integral_le)
also have "... = ln (g b) - ln (g t)"
using * t_in by simp
finally have "K * (b - t) + ln (g t) ≤ ln (g b)" (is "?lhs ≤ ?rhs")
by simp
hence "exp ?lhs ≤ exp ?rhs"
by simp
hence "g t * exp (K * (b - t)) ≤ g b"
using ‹t ∈ {a..b}› g_pos
by (simp add: ac_simps exp_add del: exp_le_cancel_iff)
hence "g t / exp (K * (t - b)) ≤ g b"
by (simp add: algebra_simps exp_diff)
thus ?thesis
by (simp add: field_simps)
qed
lemma gronwall_general:
fixes g K C a b and t::real
defines "G ≡ λt. C + K * integral {a..t} (λs. g s)"
assumes g_le_G: "⋀t. t ∈ {a..b} ⟹ g t ≤ G t"
assumes g_cont: "continuous_on {a..b} g"
assumes g_nonneg: "⋀t. t ∈ {a..b} ⟹ 0 ≤ g t"
assumes pos: "0 < C" "K > 0"
assumes "t ∈ {a..b}"
shows "g t ≤ C * exp (K * (t - a))"
proof -
have G_pos: "⋀t. t ∈ {a..b} ⟹ 0 < G t"
by (auto simp: G_def intro!: add_pos_nonneg mult_nonneg_nonneg Henstock_Kurzweil_Integration.integral_nonneg
integrable_continuous_real assms intro: less_imp_le continuous_on_subset)
have "g t ≤ G t" using assms by auto
also
{
have "(G has_vderiv_on (λt. K * g t)) {a..b}"
by (auto intro!: derivative_eq_intros integral_has_vector_derivative g_cont
simp add: G_def has_vderiv_on_def)
moreover
{
fix t assume "t ∈ {a..b}"
hence "K * g t / G t ≤ K * G t / G t"
using pos g_le_G G_pos
by (intro divide_right_mono mult_left_mono) (auto intro!: less_imp_le)
also have "… = K"
using G_pos[of t] ‹t ∈ {a .. b}› by simp
finally have "K * g t / G t ≤ K" .
}
ultimately have "G t ≤ G a * exp (K * (t - a))"
apply (rule derivative_quotient_bound)
using ‹t ∈ {a..b}›
by (auto intro!: continuous_intros g_cont G_pos simp: field_simps pos)
}
also have "G a = C"
by (simp add: G_def)
finally show ?thesis
by simp
qed
lemma gronwall_general_left:
fixes g K C a b and t::real
defines "G ≡ λt. C + K * integral {t..b} (λs. g s)"
assumes g_le_G: "⋀t. t ∈ {a..b} ⟹ g t ≤ G t"
assumes g_cont: "continuous_on {a..b} g"
assumes g_nonneg: "⋀t. t ∈ {a..b} ⟹ 0 ≤ g t"
assumes pos: "0 < C" "K > 0"
assumes "t ∈ {a..b}"
shows "g t ≤ C * exp (-K * (t - b))"
proof -
have G_pos: "⋀t. t ∈ {a..b} ⟹ 0 < G t"
by (auto simp: G_def intro!: add_pos_nonneg mult_nonneg_nonneg Henstock_Kurzweil_Integration.integral_nonneg
integrable_continuous_real assms intro: less_imp_le continuous_on_subset)
have "g t ≤ G t" using assms by auto
also
{
have "(G has_vderiv_on (λt. -K * g t)) {a..b}"
by (auto intro!: derivative_eq_intros g_cont integral_has_vector_derivative'
simp add: G_def has_vderiv_on_def)
moreover
{
fix t assume "t ∈ {a..b}"
hence "K * g t / G t ≤ K * G t / G t"
using pos g_le_G G_pos
by (intro divide_right_mono mult_left_mono) (auto intro!: less_imp_le)
also have "… = K"
using G_pos[of t] ‹t ∈ {a .. b}› by simp
finally have "K * g t / G t ≤ K" .
hence "-K ≤ -K * g t / G t"
by simp
}
ultimately
have "G t ≤ G b * exp (-K * (t - b))"
apply (rule derivative_quotient_bound_left)
using ‹t ∈ {a..b}›
by (auto intro!: continuous_intros g_cont G_pos simp: field_simps pos)
}
also have "G b = C"
by (simp add: G_def)
finally show ?thesis
by simp
qed
lemma gronwall_general_segment:
fixes a b::real
assumes "⋀t. t ∈ closed_segment a b ⟹ g t ≤ C + K * integral (closed_segment a t) g"
and "continuous_on (closed_segment a b) g"
and "⋀t. t ∈ closed_segment a b ⟹ 0 ≤ g t"
and "0 < C"
and "0 < K"
and "t ∈ closed_segment a b"
shows "g t ≤ C * exp (K * abs (t - a))"
proof cases
assume "a ≤ b"
then have *: "abs (t - a) = t -a" using assms by (auto simp: closed_segment_eq_real_ivl)
show ?thesis
unfolding *
using assms
by (intro gronwall_general[where b=b]) (auto intro!: simp: closed_segment_eq_real_ivl ‹a ≤ b›)
next
assume "¬a ≤ b"
then have *: "K * abs (t - a) = - K * (t - a)" using assms by (auto simp: closed_segment_eq_real_ivl algebra_simps)
{
fix s :: real
assume a1: "b ≤ s"
assume a2: "s ≤ a"
assume a3: "⋀t. b ≤ t ∧ t ≤ a ⟹ g t ≤ C + K * integral (if a ≤ t then {a..t} else {t..a}) g"
have "s = a ∨ s < a"
using a2 by (meson less_eq_real_def)
then have "g s ≤ C + K * integral {s..a} g"
using a3 a1 by fastforce
} then show ?thesis
unfolding *
using assms ‹¬a ≤ b›
by (intro gronwall_general_left)
(auto intro!: simp: closed_segment_eq_real_ivl)
qed
lemma gronwall_more_general_segment:
fixes a b c::real
assumes "⋀t. t ∈ closed_segment a b ⟹ g t ≤ C + K * integral (closed_segment c t) g"
and cont: "continuous_on (closed_segment a b) g"
and "⋀t. t ∈ closed_segment a b ⟹ 0 ≤ g t"
and "0 < C"
and "0 < K"
and t: "t ∈ closed_segment a b"
and c: "c ∈ closed_segment a b"
shows "g t ≤ C * exp (K * abs (t - c))"
proof -
from t c have "t ∈ closed_segment c a ∨ t ∈ closed_segment c b"
by (auto simp: closed_segment_eq_real_ivl split_ifs)
then show ?thesis
proof
assume "t ∈ closed_segment c a"
moreover
have subs: "closed_segment c a ⊆ closed_segment a b" using t c
by (auto simp: closed_segment_eq_real_ivl split_ifs)
ultimately show ?thesis
by (intro gronwall_general_segment[where b=a])
(auto intro!: assms intro: continuous_on_subset)
next
assume "t ∈ closed_segment c b"
moreover
have subs: "closed_segment c b ⊆ closed_segment a b" using t c
by (auto simp: closed_segment_eq_real_ivl)
ultimately show ?thesis
by (intro gronwall_general_segment[where b=b])
(auto intro!: assms intro: continuous_on_subset)
qed
qed
lemma gronwall:
fixes g K C and t::real
defines "G ≡ λt. C + K * integral {0..t} (λs. g s)"
assumes g_le_G: "⋀t. 0 ≤ t ⟹ t ≤ a ⟹ g t ≤ G t"
assumes g_cont: "continuous_on {0..a} g"
assumes g_nonneg: "⋀t. 0 ≤ t ⟹ t ≤ a ⟹ 0 ≤ g t"
assumes pos: "0 < C" "0 < K"
assumes "0 ≤ t" "t ≤ a"
shows "g t ≤ C * exp (K * t)"
apply(rule gronwall_general[where a=0, simplified, OF assms(2-6)[unfolded G_def]])
using assms(7,8)
by simp_all
lemma gronwall_left:
fixes g K C and t::real
defines "G ≡ λt. C + K * integral {t..0} (λs. g s)"
assumes g_le_G: "⋀t. a ≤ t ⟹ t ≤ 0 ⟹ g t ≤ G t"
assumes g_cont: "continuous_on {a..0} g"
assumes g_nonneg: "⋀t. a ≤ t ⟹ t ≤ 0 ⟹ 0 ≤ g t"
assumes pos: "0 < C" "0 < K"
assumes "a ≤ t" "t ≤ 0"
shows "g t ≤ C * exp (-K * t)"
apply(simp, rule gronwall_general_left[where b=0, simplified, OF assms(2-6)[unfolded G_def]])
using assms(7,8)
by simp_all
end
Theory Initial_Value_Problem
section‹Initial Value Problems›
theory Initial_Value_Problem
imports
"../ODE_Auxiliarities"
"../Library/Interval_Integral_HK"
"../Library/Gronwall"
begin
lemma clamp_le[simp]: "x ≤ a ⟹ clamp a b x = a" for x::"'a::ordered_euclidean_space"
by (auto simp: clamp_def eucl_le[where 'a='a] intro!: euclidean_eqI[where 'a='a])
lemma clamp_ge[simp]: "a ≤ b ⟹ b ≤ x ⟹ clamp a b x = b" for x::"'a::ordered_euclidean_space"
by (force simp: clamp_def eucl_le[where 'a='a] not_le not_less intro!: euclidean_eqI[where 'a='a])
abbreviation cfuncset :: "'a::topological_space set ⇒ 'b::metric_space set ⇒ ('a ⇒⇩C 'b) set"
(infixr "→⇩C" 60)
where "A →⇩C B ≡ PiC A (λ_. B)"
lemma closed_segment_translation_zero: "z ∈ {z + a--z + b} ⟷ 0 ∈ {a -- b}"
by (metis add.right_neutral closed_segment_translation_eq)
lemma closed_segment_subset_interval: "is_interval T ⟹ a ∈ T ⟹ b ∈ T ⟹ closed_segment a b ⊆ T"
by (rule closed_segment_subset) (auto intro!: closed_segment_subset is_interval_convex)
definition half_open_segment::"'a::real_vector ⇒ 'a ⇒ 'a set" ("(1{_--<_})")
where "half_open_segment a b = {a -- b} - {b}"
lemma half_open_segment_real:
fixes a b::real
shows "{a --< b} = (if a ≤ b then {a ..< b} else {b <.. a})"
by (auto simp: half_open_segment_def closed_segment_eq_real_ivl)
lemma closure_half_open_segment:
fixes a b::real
shows "closure {a --< b} = (if a = b then {} else {a -- b})"
unfolding closed_segment_eq_real_ivl if_distrib half_open_segment_real
unfolding if_distribR
by simp
lemma half_open_segment_subset[intro, simp]:
"{t0--<t1} ⊆ {t0 -- t1}"
"x ∈ {t0--<t1} ⟹ x ∈ {t0 -- t1}"
by (auto simp: half_open_segment_def)
lemma half_open_segment_closed_segmentI:
"t ∈ {t0 -- t1} ⟹ t ≠ t1 ⟹ t ∈ {t0 --< t1}"
by (auto simp: half_open_segment_def)
lemma islimpt_half_open_segment:
fixes t0 t1 s::real
assumes "t0 ≠ t1" "s ∈ {t0--t1}"
shows "s islimpt {t0--<t1}"
proof -
have "s islimpt {t0..<t1}" if "t0 ≤ s" "s ≤ t1" for s
proof -
have *: "{t0..<t1} - {s} = {t0..<s} ∪ {s<..<t1}"
using that by auto
show ?thesis
using that ‹t0 ≠ t1› *
by (cases "t0 = s") (auto simp: islimpt_in_closure)
qed
moreover have "s islimpt {t1<..t0}" if "t1 ≤ s" "s ≤ t0" for s
proof -
have *: "{t1<..t0} - {s} = {t1<..<s} ∪ {s<..t0}"
using that by auto
show ?thesis
using that ‹t0 ≠ t1› *
by (cases "t0 = s") (auto simp: islimpt_in_closure)
qed
ultimately show ?thesis using assms
by (auto simp: half_open_segment_real closed_segment_eq_real_ivl)
qed
lemma
mem_half_open_segment_eventually_in_closed_segment:
fixes t::real
assumes "t ∈ {t0--<t1'}"
shows "∀⇩F t1' in at t1' within {t0--<t1'}. t ∈ {t0--t1'}"
unfolding half_open_segment_real
proof (split if_split, safe)
assume le: "t0 ≤ t1'"
with assms have t: "t0 ≤ t" "t < t1'"
by (auto simp: half_open_segment_real)
then have "∀⇩F t1' in at t1' within {t0..<t1'}. t0 ≤ t"
by simp
moreover
from tendsto_ident_at ‹t < t1'›
have "∀⇩F t1' in at t1' within {t0..<t1'}. t < t1'"
by (rule order_tendstoD)
ultimately show "∀⇩F t1' in at t1' within {t0..<t1'}. t ∈ {t0--t1'}"
by eventually_elim (auto simp add: closed_segment_eq_real_ivl)
next
assume le: "¬ t0 ≤ t1'"
with assms have t: "t ≤ t0" "t1' < t"
by (auto simp: half_open_segment_real)
then have "∀⇩F t1' in at t1' within {t1'<..t0}. t ≤ t0"
by simp
moreover
from tendsto_ident_at ‹t1' < t›
have "∀⇩F t1' in at t1' within {t1'<..t0}. t1' < t"
by (rule order_tendstoD)
ultimately show "∀⇩F t1' in at t1' within {t1'<..t0}. t ∈ {t0--t1'}"
by eventually_elim (auto simp add: closed_segment_eq_real_ivl)
qed
lemma closed_segment_half_open_segment_subsetI:
fixes x::real shows "x ∈ {t0--<t1} ⟹ {t0--x} ⊆ {t0--<t1}"
by (auto simp: half_open_segment_real closed_segment_eq_real_ivl split: if_split_asm)
lemma dist_component_le:
fixes x y::"'a::euclidean_space"
assumes "i ∈ Basis"
shows "dist (x ∙ i) (y ∙ i) ≤ dist x y"
using assms
by (auto simp: euclidean_dist_l2[of x y] intro: member_le_L2_set)
lemma sum_inner_Basis_one: "i ∈ Basis ⟹ (∑x∈Basis. x ∙ i) = 1"
by (subst sum.mono_neutral_right[where S="{i}"])
(auto simp: inner_not_same_Basis)
lemma cball_in_cbox:
fixes y::"'a::euclidean_space"
shows "cball y r ⊆ cbox (y - r *⇩R One) (y + r *⇩R One)"
unfolding scaleR_sum_right interval_cbox cbox_def
proof safe
fix x i::'a assume "i ∈ Basis" "x ∈ cball y r"
with dist_component_le[OF ‹i ∈ Basis›, of y x]
have "dist (y ∙ i) (x ∙ i) ≤ r" by (simp add: mem_cball)
thus "(y - sum ((*⇩R) r) Basis) ∙ i ≤ x ∙ i"
"x ∙ i ≤ (y + sum ((*⇩R) r) Basis) ∙ i"
by (auto simp add: inner_diff_left inner_add_left inner_sum_left
sum_distrib_left[symmetric] sum_inner_Basis_one ‹i∈Basis› dist_real_def)
qed
lemma centered_cbox_in_cball:
shows "cbox (- r *⇩R One) (r *⇩R One::'a::euclidean_space) ⊆
cball 0 (sqrt(DIM('a)) * r)"
proof
fix x::'a
have "norm x ≤ sqrt(DIM('a)) * infnorm x"
by (rule norm_le_infnorm)
also
assume "x ∈ cbox (- r *⇩R One) (r *⇩R One)"
hence "infnorm x ≤ r"
by (auto simp: infnorm_def mem_box intro!: cSup_least)
finally show "x ∈ cball 0 (sqrt(DIM('a)) * r)"
by (auto simp: dist_norm mult_left_mono mem_cball)
qed
subsection ‹Solutions of IVPs \label{sec:solutions}›
definition
solves_ode :: "(real ⇒ 'a::real_normed_vector) ⇒ (real ⇒ 'a ⇒ 'a) ⇒ real set ⇒ 'a set ⇒ bool"
(infix "(solves'_ode)" 50)
where
"(y solves_ode f) T X ⟷ (y has_vderiv_on (λt. f t (y t))) T ∧ y ∈ T → X"
lemma solves_odeI:
assumes solves_ode_vderivD: "(y has_vderiv_on (λt. f t (y t))) T"
and solves_ode_domainD: "⋀t. t ∈ T ⟹ y t ∈ X"
shows "(y solves_ode f) T X"
using assms
by (auto simp: solves_ode_def)
lemma solves_odeD:
assumes "(y solves_ode f) T X"
shows solves_ode_vderivD: "(y has_vderiv_on (λt. f t (y t))) T"
and solves_ode_domainD: "⋀t. t ∈ T ⟹ y t ∈ X"
using assms
by (auto simp: solves_ode_def)
lemma solves_ode_continuous_on: "(y solves_ode f) T X ⟹ continuous_on T y"
by (auto intro!: vderiv_on_continuous_on simp: solves_ode_def)
lemma solves_ode_congI:
assumes "(x solves_ode f) T X"
assumes "⋀t. t ∈ T ⟹ x t = y t"
assumes "⋀t. t ∈ T ⟹ f t (x t) = g t (x t)"
assumes "T = S" "X = Y"
shows "(y solves_ode g) S Y"
using assms
by (auto simp: solves_ode_def Pi_iff)
lemma solves_ode_cong[cong]:
assumes "⋀t. t ∈ T ⟹ x t = y t"
assumes "⋀t. t ∈ T ⟹ f t (x t) = g t (x t)"
assumes "T = S" "X = Y"
shows "(x solves_ode f) T X ⟷ (y solves_ode g) S Y"
using assms
by (auto simp: solves_ode_def Pi_iff)
lemma solves_ode_on_subset:
assumes "(x solves_ode f) S Y"
assumes "T ⊆ S" "Y ⊆ X"
shows "(x solves_ode f) T X"
using assms
by (auto simp: solves_ode_def has_vderiv_on_subset)
lemma preflect_solution:
assumes "t0 ∈ T"
assumes sol: "((λt. x (preflect t0 t)) solves_ode (λt x. - f (preflect t0 t) x)) (preflect t0 ` T) X"
shows "(x solves_ode f) T X"
proof (rule solves_odeI)
from solves_odeD[OF sol]
have xm_deriv: "(x o preflect t0 has_vderiv_on (λt. - f (preflect t0 t) (x (preflect t0 t)))) (preflect t0 ` T)"
and xm_mem: "t ∈ preflect t0 ` T ⟹ x (preflect t0 t) ∈ X" for t
by simp_all
have "(x o preflect t0 o preflect t0 has_vderiv_on (λt. f t (x t))) T"
apply (rule has_vderiv_on_eq_rhs)
apply (rule has_vderiv_on_compose)
apply (rule xm_deriv)
apply (auto simp: preflect_def intro!: derivative_intros)
done
then show "(x has_vderiv_on (λt. f t (x t))) T"
by (simp add: preflect_def)
show "x t ∈ X" if "t ∈ T" for t
using that xm_mem[of "preflect t0 t"]
by (auto simp: preflect_def)
qed
lemma solution_preflect:
assumes "t0 ∈ T"
assumes sol: "(x solves_ode f) T X"
shows "((λt. x (preflect t0 t)) solves_ode (λt x. - f (preflect t0 t) x)) (preflect t0 ` T) X"
using sol ‹t0 ∈ T›
by (simp_all add: preflect_def image_image preflect_solution[of t0])
lemma solution_eq_preflect_solution:
assumes "t0 ∈ T"
shows "(x solves_ode f) T X ⟷ ((λt. x (preflect t0 t)) solves_ode (λt x. - f (preflect t0 t) x)) (preflect t0 ` T) X"
using solution_preflect[OF ‹t0 ∈ T›] preflect_solution[OF ‹t0 ∈ T›]
by blast
lemma shift_autonomous_solution:
assumes sol: "(x solves_ode f) T X"
assumes auto: "⋀s t. s ∈ T ⟹ f s (x s) = f t (x s)"
shows "((λt. x (t + t0)) solves_ode f) ((λt. t - t0) ` T) X"
using solves_odeD[OF sol]
apply (intro solves_odeI)
apply (rule has_vderiv_on_compose'[of x, THEN has_vderiv_on_eq_rhs])
apply (auto simp: image_image intro!: auto derivative_intros)
done
lemma solves_ode_singleton: "y t0 ∈ X ⟹ (y solves_ode f) {t0} X"
by (auto intro!: solves_odeI has_vderiv_on_singleton)
subsubsection‹Connecting solutions›
text‹\label{sec:combining-solutions}›
lemma connection_solves_ode:
assumes x: "(x solves_ode f) T X"
assumes y: "(y solves_ode g) S Y"
assumes conn_T: "closure S ∩ closure T ⊆ T"
assumes conn_S: "closure S ∩ closure T ⊆ S"
assumes conn_x: "⋀t. t ∈ closure S ⟹ t ∈ closure T ⟹ x t = y t"
assumes conn_f: "⋀t. t ∈ closure S ⟹ t ∈ closure T ⟹ f t (y t) = g t (y t)"
shows "((λt. if t ∈ T then x t else y t) solves_ode (λt. if t ∈ T then f t else g t)) (T ∪ S) (X ∪ Y)"
proof (rule solves_odeI)
from solves_odeD(2)[OF x] solves_odeD(2)[OF y]
show "t ∈ T ∪ S ⟹ (if t ∈ T then x t else y t) ∈ X ∪ Y" for t
by auto
show "((λt. if t ∈ T then x t else y t) has_vderiv_on (λt. (if t ∈ T then f t else g t) (if t ∈ T then x t else y t))) (T ∪ S)"
apply (rule has_vderiv_on_If[OF refl, THEN has_vderiv_on_eq_rhs])
unfolding Un_absorb2[OF conn_T] Un_absorb2[OF conn_S]
apply (rule solves_odeD(1)[OF x])
apply (rule solves_odeD(1)[OF y])
apply (simp_all add: conn_T conn_S Un_absorb2 conn_x conn_f)
done
qed
lemma
solves_ode_subset_range:
assumes x: "(x solves_ode f) T X"
assumes s: "x ` T ⊆ Y"
shows "(x solves_ode f) T Y"
using assms
by (auto intro!: solves_odeI dest!: solves_odeD)
subsection ‹unique solution with initial value›
definition
usolves_ode_from :: "(real ⇒ 'a::real_normed_vector) ⇒ (real ⇒ 'a ⇒ 'a) ⇒ real ⇒ real set ⇒ 'a set ⇒ bool"
("((_) usolves'_ode (_) from (_))" [10, 10, 10] 10)
where
"(y usolves_ode f from t0) T X ⟷ (y solves_ode f) T X ∧ t0 ∈ T ∧ is_interval T ∧
(∀z T'. t0 ∈ T' ∧ is_interval T' ∧ T' ⊆ T ∧ (z solves_ode f) T' X ⟶ z t0 = y t0 ⟶ (∀t ∈ T'. z t = y t))"
text ‹uniqueness of solution can depend on domain ‹X›:›
lemma
"((λ_. 0::real) usolves_ode (λ_. sqrt) from 0) {0..} {0}"
"((λt. t⇧2 / 4) solves_ode (λ_. sqrt)) {0..} {0..}"
"(λt. t⇧2 / 4) 0 = (λ_. 0::real) 0"
by (auto intro!: derivative_eq_intros
simp: has_vderiv_on_def has_vector_derivative_def usolves_ode_from_def solves_ode_def
is_interval_ci real_sqrt_divide)
text ‹TODO: show that if solution stays in interior, then domain can be enlarged! (?)›
lemma usolves_odeD:
assumes "(y usolves_ode f from t0) T X"
shows "(y solves_ode f) T X"
and "t0 ∈ T"
and "is_interval T"
and "⋀z T' t. t0 ∈ T' ⟹ is_interval T' ⟹ T' ⊆ T ⟹(z solves_ode f) T' X ⟹ z t0 = y t0 ⟹ t ∈ T' ⟹ z t = y t"
using assms
unfolding usolves_ode_from_def
by blast+
lemma usolves_ode_rawI:
assumes "(y solves_ode f) T X" "t0 ∈ T" "is_interval T"
assumes "⋀z T' t. t0 ∈ T' ⟹ is_interval T' ⟹ T' ⊆ T ⟹ (z solves_ode f) T' X ⟹ z t0 = y t0 ⟹ t ∈ T' ⟹ z t = y t"
shows "(y usolves_ode f from t0) T X"
using assms
unfolding usolves_ode_from_def
by blast
lemma usolves_odeI:
assumes "(y solves_ode f) T X" "t0 ∈ T" "is_interval T"
assumes usol: "⋀z t. {t0 -- t} ⊆ T ⟹ (z solves_ode f) {t0 -- t} X ⟹ z t0 = y t0 ⟹ z t = y t"
shows "(y usolves_ode f from t0) T X"
proof (rule usolves_ode_rawI; fact?)
fix z T' t
assume T': "t0 ∈ T'" "is_interval T'" "T' ⊆ T"
and z: "(z solves_ode f) T' X" and iv: "z t0 = y t0" and t: "t ∈ T'"
have subset_T': "{t0 -- t} ⊆ T'"
by (rule closed_segment_subset_interval; fact)
with z have sol_cs: "(z solves_ode f) {t0 -- t} X"
by (rule solves_ode_on_subset[OF _ _ order_refl])
from subset_T' have subset_T: "{t0 -- t} ⊆ T"
using ‹T' ⊆ T› by simp
from usol[OF subset_T sol_cs iv]
show "z t = y t" by simp
qed
lemma is_interval_singleton[intro,simp]: "is_interval {t0}"
by (auto simp: is_interval_def intro!: euclidean_eqI[where 'a='a])
lemma usolves_ode_singleton: "x t0 ∈ X ⟹ (x usolves_ode f from t0) {t0} X"
by (auto intro!: usolves_odeI solves_ode_singleton)
lemma usolves_ode_congI:
assumes x: "(x usolves_ode f from t0) T X"
assumes "⋀t. t ∈ T ⟹ x t = y t"
assumes "⋀t y. t ∈ T ⟹ y ∈ X ⟹ f t y = g t y"
assumes "t0 = s0"
assumes "T = S"
assumes "X = Y"
shows "(y usolves_ode g from s0) S Y"
proof (rule usolves_ode_rawI)
from assms x have "(y solves_ode f) S Y"
by (auto simp add: usolves_ode_from_def)
then show "(y solves_ode g) S Y"
by (rule solves_ode_congI) (use assms in ‹auto simp: usolves_ode_from_def dest!: solves_ode_domainD›)
from assms show "s0 ∈ S" "is_interval S"
by (auto simp add: usolves_ode_from_def)
next
fix z T' t
assume hyps: "s0 ∈ T'" "is_interval T'" "T' ⊆ S" "(z solves_ode g) T' Y" "z s0 = y s0" "t ∈ T'"
from ‹(z solves_ode g) T' Y›
have zsol: "(z solves_ode f) T' Y"
by (rule solves_ode_congI) (use assms hyps in ‹auto dest!: solves_ode_domainD›)
have "z t = x t"
by (rule x[THEN usolves_odeD(4),where T' = T'])
(use zsol ‹s0 ∈ T'› ‹is_interval T'› ‹T' ⊆ S› ‹T = S› ‹z s0 = y s0› ‹t ∈ T'› assms in auto)
also have "y t = x t" using assms ‹t ∈ T'› ‹T' ⊆ S› ‹T = S› by auto
finally show "z t = y t" by simp
qed
lemma usolves_ode_cong[cong]:
assumes "⋀t. t ∈ T ⟹ x t = y t"
assumes "⋀t y. t ∈ T ⟹ y ∈ X ⟹ f t y = g t y"
assumes "t0 = s0"
assumes "T = S"
assumes "X = Y"
shows "(x usolves_ode f from t0) T X ⟷ (y usolves_ode g from s0) S Y"
apply (rule iffI)
subgoal by (rule usolves_ode_congI[OF _ assms]; assumption)
subgoal by (metis assms(1) assms(2) assms(3) assms(4) assms(5) usolves_ode_congI)
done
lemma shift_autonomous_unique_solution:
assumes usol: "(x usolves_ode f from t0) T X"
assumes auto: "⋀s t x. x ∈ X ⟹ f s x = f t x"
shows "((λt. x (t + t0 - t1)) usolves_ode f from t1) ((+) (t1 - t0) ` T) X"
proof (rule usolves_ode_rawI)
from usolves_odeD[OF usol]
have sol: "(x solves_ode f) T X"
and "t0 ∈ T"
and "is_interval T"
and unique: "t0 ∈ T' ⟹ is_interval T' ⟹ T' ⊆ T ⟹ (z solves_ode f) T' X ⟹ z t0 = x t0 ⟹ t ∈ T' ⟹ z t = x t"
for z T' t
by blast+
have "(λt. t + t1 - t0) = (+) (t1 - t0)"
by (auto simp add: algebra_simps)
with shift_autonomous_solution[OF sol auto, of "t0 - t1"] solves_odeD[OF sol]
show "((λt. x (t + t0 - t1)) solves_ode f) ((+) (t1 - t0) ` T) X"
by (simp add: algebra_simps)
from ‹t0 ∈ T› show "t1 ∈ (+) (t1 - t0) ` T" by auto
from ‹is_interval T›
show "is_interval ((+) (t1 - t0) ` T)"
by simp
fix z T' t
assume z: "(z solves_ode f) T' X"
and t0': "t1 ∈ T'" "T' ⊆ (+) (t1 - t0) ` T"
and shift: "z t1 = x (t1 + t0 - t1)"
and t: "t ∈ T'"
and ivl: "is_interval T'"
let ?z = "(λt. z (t + (t1 - t0)))"
have "(?z solves_ode f) ((λt. t - (t1 - t0)) ` T') X"
apply (rule shift_autonomous_solution[OF z, of "t1 - t0"])
using solves_odeD[OF z]
by (auto intro!: auto)
with _ _ _ have "?z ((t + (t0 - t1))) = x (t + (t0 - t1))"
apply (rule unique[where z = ?z ])
using shift t t0' ivl
by auto
then show "z t = x (t + t0 - t1)"
by (simp add: algebra_simps)
qed
lemma three_intervals_lemma:
fixes a b c::real
assumes a: "a ∈ A - B"
and b: "b ∈ B - A"
and c: "c ∈ A ∩ B"
and iA: "is_interval A" and iB: "is_interval B"
and aI: "a ∈ I"
and bI: "b ∈ I"
and iI: "is_interval I"
shows "c ∈ I"
apply (rule mem_is_intervalI[OF iI aI bI])
using iA iB
apply (auto simp: is_interval_def)
apply (metis Diff_iff Int_iff a b c le_cases)
apply (metis Diff_iff Int_iff a b c le_cases)
done
lemma connection_usolves_ode:
assumes x: "(x usolves_ode f from tx) T X"
assumes y: "⋀t. t ∈ closure S ∩ closure T ⟹ (y usolves_ode g from t) S X"
assumes conn_T: "closure S ∩ closure T ⊆ T"
assumes conn_S: "closure S ∩ closure T ⊆ S"
assumes conn_t: "t ∈ closure S ∩ closure T"
assumes conn_x: "⋀t. t ∈ closure S ⟹ t ∈ closure T ⟹ x t = y t"
assumes conn_f: "⋀t x. t ∈ closure S ⟹ t ∈ closure T ⟹ x ∈ X ⟹ f t x = g t x"
shows "((λt. if t ∈ T then x t else y t) usolves_ode (λt. if t ∈ T then f t else g t) from tx) (T ∪ S) X"
apply (rule usolves_ode_rawI)
apply (subst Un_absorb[of X, symmetric])
apply (rule connection_solves_ode[OF usolves_odeD(1)[OF x] usolves_odeD(1)[OF y[OF conn_t]] conn_T conn_S conn_x conn_f])
subgoal by assumption
subgoal by assumption
subgoal by assumption
subgoal by assumption
subgoal using solves_odeD(2)[OF usolves_odeD(1)[OF x]] conn_T by (auto simp add: conn_x[symmetric])
subgoal using usolves_odeD(2)[OF x] by auto
subgoal using usolves_odeD(3)[OF x] usolves_odeD(3)[OF y]
apply (rule is_real_interval_union)
using conn_T conn_S conn_t by auto
subgoal premises prems for z TS' s
proof -
from ‹(z solves_ode _) _ _›
have "(z solves_ode (λt. if t ∈ T then f t else g t)) (T ∩ TS') X"
by (rule solves_ode_on_subset) auto
then have z_f: "(z solves_ode f) (T ∩ TS') X"
by (subst solves_ode_cong) auto
from prems(4)
have "(z solves_ode (λt. if t ∈ T then f t else g t)) (S ∩ TS') X"
by (rule solves_ode_on_subset) auto
then have z_g: "(z solves_ode g) (S ∩ TS') X"
apply (rule solves_ode_congI)
subgoal by simp
subgoal by clarsimp (meson closure_subset conn_f contra_subsetD prems(4) solves_ode_domainD)
subgoal by simp
subgoal by simp
done
have "tx ∈ T" using assms using usolves_odeD(2)[OF x] by auto
have "z tx = x tx" using assms prems
by (simp add: ‹tx ∈ T›)
from usolves_odeD(4)[OF x _ _ _ ‹(z solves_ode f) _ _›, of s] prems
have "z s = x s" if "s ∈ T" using that ‹tx ∈ T› ‹z tx = x tx›
by (auto simp: is_interval_Int usolves_odeD(3)[OF x] ‹is_interval TS'›)
moreover
{
assume "s ∉ T"
then have "s ∈ S" using prems assms by auto
{
assume "tx ∉ S"
then have "tx ∈ T - S" using ‹tx ∈ T› by simp
moreover have "s ∈ S - T" using ‹s ∉ T› ‹s ∈ S› by blast
ultimately have "t ∈ TS'"
apply (rule three_intervals_lemma)
subgoal using assms by auto
subgoal using usolves_odeD(3)[OF x] .
subgoal using usolves_odeD(3)[OF y[OF conn_t]] .
subgoal using ‹tx ∈ TS'› .
subgoal using ‹s ∈ TS'› .
subgoal using ‹is_interval TS'› .
done
with assms have t: "t ∈ closure S ∩ closure T ∩ TS'" by simp
then have "t ∈ S" "t ∈ T" "t ∈ TS'" using assms by auto
have "z t = x t"
apply (rule usolves_odeD(4)[OF x _ _ _ z_f, of t])
using ‹t ∈ TS'› ‹t ∈ T› prems assms ‹tx ∈ T› usolves_odeD(3)[OF x]
by (auto intro!: is_interval_Int)
with assms have "z t = y t" using t by auto
from usolves_odeD(4)[OF y[OF conn_t] _ _ _ z_g, of s] prems
have "z s = y s" using ‹s ∉ T› assms ‹z t = y t› t ‹t ∈ S›
‹is_interval TS'› usolves_odeD(3)[OF y[OF conn_t]]
by (auto simp: is_interval_Int)
} moreover {
assume "tx ∈ S"
with prems closure_subset ‹tx ∈ T›
have tx: "tx ∈ closure S ∩ closure T ∩ TS'" by force
then have "tx ∈ S" "tx ∈ T" "tx ∈ TS'" using assms by auto
have "z tx = x tx"
apply (rule usolves_odeD(4)[OF x _ _ _ z_f, of tx])
using ‹tx ∈ TS'› ‹tx ∈ T› prems assms ‹tx ∈ T› usolves_odeD(3)[OF x]
by (auto intro!: is_interval_Int)
with assms have "z tx = y tx" using tx by auto
from usolves_odeD(4)[OF y[where t=tx] _ _ _ z_g, of s] prems
have "z s = y s" using ‹s ∉ T› assms ‹z tx = y tx› tx ‹tx ∈ S›
‹is_interval TS'› usolves_odeD(3)[OF y]
by (auto simp: is_interval_Int)
} ultimately have "z s = y s" by blast
}
ultimately
show "z s = (if s ∈ T then x s else y s)" by simp
qed
done
lemma usolves_ode_union_closed:
assumes x: "(x usolves_ode f from tx) T X"
assumes y: "⋀t. t ∈ closure S ∩ closure T ⟹ (x usolves_ode f from t) S X"
assumes conn_T: "closure S ∩ closure T ⊆ T"
assumes conn_S: "closure S ∩ closure T ⊆ S"
assumes conn_t: "t ∈ closure S ∩ closure T"
shows "(x usolves_ode f from tx) (T ∪ S) X"
using connection_usolves_ode[OF assms] by simp
lemma usolves_ode_solves_odeI:
assumes "(x usolves_ode f from tx) T X"
assumes "(y solves_ode f) T X" "y tx = x tx"
shows "(y usolves_ode f from tx) T X"
using assms(1)
apply (rule usolves_ode_congI)
subgoal using assms by (metis set_eq_subset usolves_odeD(2) usolves_odeD(3) usolves_odeD(4))
by auto
lemma usolves_ode_subset_range:
assumes x: "(x usolves_ode f from t0) T X"
assumes r: "x ` T ⊆ Y" and "Y ⊆ X"
shows "(x usolves_ode f from t0) T Y"
proof (rule usolves_odeI)
note usolves_odeD[OF x]
show "(x solves_ode f) T Y" by (rule solves_ode_subset_range; fact)
show "t0 ∈ T" "is_interval T" by fact+
fix z t
assume s: "{t0 -- t} ⊆ T" and z: "(z solves_ode f) {t0 -- t} Y" and z0: "z t0 = x t0"
then have "t0 ∈ {t0 -- t}" "is_interval {t0 -- t}"
by auto
moreover note s
moreover have "(z solves_ode f) {t0--t} X"
using solves_odeD[OF z] ‹Y ⊆ X›
by (intro solves_ode_subset_range[OF z]) force
moreover note z0
moreover have "t ∈ {t0 -- t}" by simp
ultimately show "z t = x t"
by (rule usolves_odeD[OF x])
qed
subsection ‹ivp on interval›
context
fixes t0 t1::real and T
defines "T ≡ closed_segment t0 t1"
begin
lemma is_solution_ext_cont:
"continuous_on T x ⟹ (ext_cont x (min t0 t1) (max t0 t1) solves_ode f) T X = (x solves_ode f) T X"
by (rule solves_ode_cong) (auto simp add: T_def min_def max_def closed_segment_eq_real_ivl)
lemma solution_fixed_point:
fixes x:: "real ⇒ 'a::banach"
assumes x: "(x solves_ode f) T X" and t: "t ∈ T"
shows "x t0 + ivl_integral t0 t (λt. f t (x t)) = x t"
proof -
from solves_odeD(1)[OF x, unfolded T_def]
have "(x has_vderiv_on (λt. f t (x t))) (closed_segment t0 t)"
by (rule has_vderiv_on_subset) (insert ‹t ∈ T›, auto simp: closed_segment_eq_real_ivl T_def)
from fundamental_theorem_of_calculus_ivl_integral[OF this]
have "((λt. f t (x t)) has_ivl_integral x t - x t0) t0 t" .
from this[THEN ivl_integral_unique]
show ?thesis by simp
qed
lemma solution_fixed_point_left:
fixes x:: "real ⇒ 'a::banach"
assumes x: "(x solves_ode f) T X" and t: "t ∈ T"
shows "x t1 - ivl_integral t t1 (λt. f t (x t)) = x t"
proof -
from solves_odeD(1)[OF x, unfolded T_def]
have "(x has_vderiv_on (λt. f t (x t))) (closed_segment t t1)"
by (rule has_vderiv_on_subset) (insert ‹t ∈ T›, auto simp: closed_segment_eq_real_ivl T_def)
from fundamental_theorem_of_calculus_ivl_integral[OF this]
have "((λt. f t (x t)) has_ivl_integral x t1 - x t) t t1" .
from this[THEN ivl_integral_unique]
show ?thesis by simp
qed
lemma solution_fixed_pointI:
fixes x:: "real ⇒ 'a::banach"
assumes cont_f: "continuous_on (T × X) (λ(t, x). f t x)"
assumes cont_x: "continuous_on T x"
assumes defined: "⋀t. t ∈ T ⟹ x t ∈ X"
assumes fp: "⋀t. t ∈ T ⟹ x t = x t0 + ivl_integral t0 t (λt. f t (x t))"
shows "(x solves_ode f) T X"
proof (rule solves_odeI)
note [continuous_intros] = continuous_on_compose_Pair[OF cont_f]
have "((λt. x t0 + ivl_integral t0 t (λt. f t (x t))) has_vderiv_on (λt. f t (x t))) T"
using cont_x defined
by (auto intro!: derivative_eq_intros ivl_integral_has_vector_derivative
continuous_intros
simp: has_vderiv_on_def T_def)
with fp show "(x has_vderiv_on (λt. f t (x t))) T" by simp
qed (simp add: defined)
end
lemma solves_ode_half_open_segment_continuation:
fixes f::"real ⇒ 'a ⇒ 'a::banach"
assumes ode: "(x solves_ode f) {t0 --< t1} X"
assumes continuous: "continuous_on ({t0 -- t1} × X) (λ(t, x). f t x)"
assumes "compact X"
assumes "t0 ≠ t1"
obtains l where
"(x ⤏ l) (at t1 within {t0 --< t1})"
"((λt. if t = t1 then l else x t) solves_ode f) {t0 -- t1} X"
proof -
note [continuous_intros] = continuous_on_compose_Pair[OF continuous]
have "compact ((λ(t, x). f t x) ` ({t0 -- t1} × X))"
by (auto intro!: compact_continuous_image continuous_intros compact_Times ‹compact X›
simp: split_beta)
then obtain B where "B > 0" and B: "⋀t x. t ∈ {t0 -- t1} ⟹ x ∈ X ⟹ norm (f t x) ≤ B"
by (auto dest!: compact_imp_bounded simp: bounded_pos)
have uc: "uniformly_continuous_on {t0 --< t1} x"
apply (rule lipschitz_on_uniformly_continuous[where L=B])
apply (rule bounded_vderiv_on_imp_lipschitz)
apply (rule solves_odeD[OF ode])
using solves_odeD(2)[OF ode] ‹0 < B›
by (auto simp: closed_segment_eq_real_ivl half_open_segment_real subset_iff
intro!: B split: if_split_asm)
have "t1 ∈ closure ({t0 --< t1})"
using closure_half_open_segment[of t0 t1] ‹t0 ≠ t1›
by simp
from uniformly_continuous_on_extension_on_closure[OF uc]
obtain g where uc_g: "uniformly_continuous_on {t0--t1} g"
and xg: "(⋀t. t ∈ {t0 --< t1} ⟹ x t = g t)"
using closure_half_open_segment[of t0 t1] ‹t0 ≠ t1›
by metis
from uc_g[THEN uniformly_continuous_imp_continuous, unfolded continuous_on_def]
have "(g ⤏ g t) (at t within {t0--t1})" if "t∈{t0--t1}" for t
using that by auto
then have g_tendsto: "(g ⤏ g t) (at t within {t0--<t1})" if "t∈{t0--t1}" for t
using that by (auto intro: tendsto_within_subset half_open_segment_subset)
then have x_tendsto: "(x ⤏ g t) (at t within {t0--<t1})" if "t∈{t0--t1}" for t
using that
by (subst Lim_cong_within[OF refl refl refl xg]) auto
then have "(x ⤏ g t1) (at t1 within {t0 --< t1})"
by auto
moreover
have nbot: "at s within {t0--<t1} ≠ bot" if "s ∈ {t0--t1}" for s
using that ‹t0 ≠ t1›
by (auto simp: trivial_limit_within islimpt_half_open_segment)
have g_mem: "s ∈ {t0--t1} ⟹ g s ∈ X" for s
apply (rule Lim_in_closed_set[OF compact_imp_closed[OF ‹compact X›] _ _ x_tendsto])
using solves_odeD(2)[OF ode] ‹t0 ≠ t1›
by (auto intro!: simp: eventually_at_filter nbot)
have "(g solves_ode f) {t0 -- t1} X"
apply (rule solution_fixed_pointI[OF continuous])
subgoal by (auto intro!: uc_g uniformly_continuous_imp_continuous)
subgoal by (rule g_mem)
subgoal premises prems for s
proof -
{
fix s
assume s: "s ∈ {t0--<t1}"
with prems have subs: "{t0--s} ⊆ {t0--<t1}"
by (auto simp: half_open_segment_real closed_segment_eq_real_ivl)
with ode have sol: "(x solves_ode f) ({t0--s}) X"
by (rule solves_ode_on_subset) (rule order_refl)
from subs have inner_eq: "t ∈ {t0 -- s} ⟹ x t = g t" for t
by (intro xg) auto
from solution_fixed_point[OF sol, of s]
have "g t0 + ivl_integral t0 s (λt. f t (g t)) - g s = 0"
using s prems ‹t0 ≠ t1›
by (auto simp: inner_eq cong: ivl_integral_cong)
} note fp = this
from prems have subs: "{t0--s} ⊆ {t0--t1}"
by (auto simp: closed_segment_eq_real_ivl)
have int: "(λt. f t (g t)) integrable_on {t0--t1}"
using prems subs
by (auto intro!: integrable_continuous_closed_segment continuous_intros g_mem
uc_g[THEN uniformly_continuous_imp_continuous, THEN continuous_on_subset])
note ivl_tendsto[tendsto_intros] =
indefinite_ivl_integral_continuous(1)[OF int, unfolded continuous_on_def, rule_format]
from subs half_open_segment_subset
have "((λs. g t0 + ivl_integral t0 s (λt. f t (g t)) - g s) ⤏
g t0 + ivl_integral t0 s (λt. f t (g t)) - g s) (at s within {t0 --< t1})"
using subs
by (auto intro!: tendsto_intros ivl_tendsto[THEN tendsto_within_subset]
g_tendsto[THEN tendsto_within_subset])
moreover
have "((λs. g t0 + ivl_integral t0 s (λt. f t (g t)) - g s) ⤏ 0) (at s within {t0 --< t1})"
apply (subst Lim_cong_within[OF refl refl refl, where g="λ_. 0"])
subgoal by (subst fp) auto
subgoal by simp
done
ultimately have "g t0 + ivl_integral t0 s (λt. f t (g t)) - g s = 0"
using nbot prems tendsto_unique by blast
then show "g s = g t0 + ivl_integral t0 s (λt. f t (g t))" by simp
qed
done
then have "((λt. if t = t1 then g t1 else x t) solves_ode f) {t0--t1} X"
apply (rule solves_ode_congI)
using xg ‹t0 ≠ t1›
by (auto simp: half_open_segment_closed_segmentI)
ultimately show ?thesis ..
qed
subsection ‹Picard-Lindeloef on set of functions into closed set›
text‹\label{sec:plclosed}›
locale continuous_rhs = fixes T X f
assumes continuous: "continuous_on (T × X) (λ(t, x). f t x)"
begin
lemma continuous_rhs_comp[continuous_intros]:
assumes [continuous_intros]: "continuous_on S g"
assumes [continuous_intros]: "continuous_on S h"
assumes "g ` S ⊆ T"
assumes "h ` S ⊆ X"
shows "continuous_on S (λx. f (g x) (h x))"
using continuous_on_compose_Pair[OF continuous assms(1,2)] assms(3,4)
by auto
end
locale global_lipschitz =
fixes T X f and L::real
assumes lipschitz: "⋀t. t ∈ T ⟹ L-lipschitz_on X (λx. f t x)"
locale closed_domain =
fixes X assumes closed: "closed X"
locale interval = fixes T::"real set"
assumes interval: "is_interval T"
begin
lemma closed_segment_subset_domain: "t0 ∈ T ⟹ t ∈ T ⟹ closed_segment t0 t ⊆ T"
by (simp add: closed_segment_subset_interval interval)
lemma closed_segment_subset_domainI: "t0 ∈ T ⟹ t ∈ T ⟹ s ∈ closed_segment t0 t ⟹ s ∈ T"
using closed_segment_subset_domain by force
lemma convex[intro, simp]: "convex T"
and connected[intro, simp]: "connected T"
by (simp_all add: interval is_interval_connected is_interval_convex )
end
locale nonempty_set = fixes T assumes nonempty_set: "T ≠ {}"
locale compact_interval = interval + nonempty_set T +
assumes compact_time: "compact T"
begin
definition "tmin = Inf T"
definition "tmax = Sup T"
lemma
shows tmin: "t ∈ T ⟹ tmin ≤ t" "tmin ∈ T"
and tmax: "t ∈ T ⟹ t ≤ tmax" "tmax ∈ T"
using nonempty_set
by (auto intro!: cInf_lower cSup_upper bounded_imp_bdd_below bounded_imp_bdd_above
compact_imp_bounded compact_time closed_contains_Inf closed_contains_Sup compact_imp_closed
simp: tmin_def tmax_def)
lemma tmin_le_tmax[intro, simp]: "tmin ≤ tmax"
using nonempty_set tmin tmax by auto
lemma T_def: "T = {tmin .. tmax}"
using closed_segment_subset_interval[OF interval tmin(2) tmax(2)]
by (auto simp: closed_segment_eq_real_ivl subset_iff intro!: tmin tmax)
lemma mem_T_I[intro, simp]: "tmin ≤ t ⟹ t ≤ tmax ⟹ t ∈ T"
using interval mem_is_interval_1_I tmax(2) tmin(2) by blast
end
locale self_mapping = interval T for T +
fixes t0::real and x0 f X
assumes iv_defined: "t0 ∈ T" "x0 ∈ X"
assumes self_mapping:
"⋀x t. t ∈ T ⟹ x t0 = x0 ⟹ x ∈ closed_segment t0 t → X ⟹
continuous_on (closed_segment t0 t) x ⟹ x t0 + ivl_integral t0 t (λt. f t (x t)) ∈ X"
begin
sublocale nonempty_set T using iv_defined by unfold_locales auto
lemma closed_segment_iv_subset_domain: "t ∈ T ⟹ closed_segment t0 t ⊆ T"
by (simp add: closed_segment_subset_domain iv_defined)
end
locale unique_on_closed =
compact_interval T +
self_mapping T t0 x0 f X +
continuous_rhs T X f +
closed_domain X +
global_lipschitz T X f L for t0::real and T and x0::"'a::banach" and f X L
begin
lemma T_split: "T = {tmin .. t0} ∪ {t0 .. tmax}"
by (metis T_def atLeastAtMost_iff iv_defined(1) ivl_disj_un_two_touch(4))
lemma L_nonneg: "0 ≤ L"
by (auto intro!: lipschitz_on_nonneg[OF lipschitz] iv_defined)
text ‹Picard Iteration›
definition P_inner where "P_inner x t = x0 + ivl_integral t0 t (λt. f t (x t))"
definition P::"(real ⇒⇩C 'a) ⇒ (real ⇒⇩C 'a)"
where "P x = (SOME g::real⇒⇩C 'a.
(∀t ∈ T. g t = P_inner x t) ∧
(∀t≤tmin. g t = P_inner x tmin) ∧
(∀t≥tmax. g t = P_inner x tmax))"
lemma cont_P_inner_ivl:
"x ∈ T →⇩C X ⟹ continuous_on {tmin..tmax} (P_inner (apply_bcontfun x))"
apply (auto simp: real_Icc_closed_segment P_inner_def Pi_iff mem_PiC_iff
intro!: continuous_intros indefinite_ivl_integral_continuous_subset
integrable_continuous_closed_segment tmin(1) tmax(1))
using closed_segment_subset_domainI tmax(2) tmin(2) apply blast
using closed_segment_subset_domainI tmax(2) tmin(2) apply blast
using T_def closed_segment_eq_real_ivl iv_defined(1) by auto
lemma P_inner_t0[simp]: "P_inner g t0 = x0"
by (simp add: P_inner_def)
lemma t0_cs_tmin_tmax: "t0 ∈ {tmin--tmax}" and cs_tmin_tmax_subset: "{tmin--tmax} ⊆ T"
using iv_defined T_def closed_segment_eq_real_ivl
by auto
lemma
P_eqs:
assumes "x ∈ T →⇩C X"
shows P_eq_P_inner: "t ∈ T ⟹ P x t = P_inner x t"
and P_le_tmin: "t ≤ tmin ⟹ P x t = P_inner x tmin"
and P_ge_tmax: "t ≥ tmax ⟹ P x t = P_inner x tmax"
unfolding atomize_conj atomize_imp
proof goal_cases
case 1
obtain g where
"t ∈ {tmin .. tmax} ⟹ apply_bcontfun g t = P_inner (apply_bcontfun x) t"
"apply_bcontfun g t = P_inner (apply_bcontfun x) (clamp tmin tmax t)"
for t
by (metis continuous_on_cbox_bcontfunE cont_P_inner_ivl[OF assms(1)] cbox_interval)
with T_def have "∃g::real⇒⇩C 'a.
(∀t ∈ T. g t = P_inner x t) ∧
(∀t≤tmin. g t = P_inner x tmin) ∧
(∀t≥tmax. g t = P_inner x tmax)"
by (auto intro!: exI[where x=g])
then have "(∀t ∈ T. P x t = P_inner x t) ∧
(∀t≤tmin. P x t = P_inner x tmin) ∧
(∀t≥tmax. P x t = P_inner x tmax)"
unfolding P_def
by (rule someI_ex)
then show ?case using T_def by auto
qed
lemma P_if_eq:
"x ∈ T →⇩C X ⟹
P x t = (if tmin ≤ t ∧ t ≤ tmax then P_inner x t else if t ≥ tmax then P_inner x tmax else P_inner x tmin)"
by (auto simp: P_eqs)
lemma dist_P_le:
assumes y: "y ∈ T →⇩C X" and z: "z ∈ T →⇩C X"
assumes le: "⋀t. tmin ≤ t ⟹ t ≤ tmax ⟹ dist (P_inner y t) (P_inner z t) ≤ R"
assumes "0 ≤ R"
shows "dist (P y t) (P z t) ≤ R"
by (cases "t ≤ tmin"; cases "t ≥ tmax") (auto simp: P_eqs y z not_le intro!: le)
lemma P_def':
assumes "t ∈ T"
assumes "fixed_point ∈ T →⇩C X"
shows "(P fixed_point) t = x0 + ivl_integral t0 t (λx. f x (fixed_point x))"
by (simp add: P_eq_P_inner assms P_inner_def)
definition "iter_space = PiC T ((λ_. X)(t0:={x0}))"
lemma iter_spaceI:
assumes "g ∈ T →⇩C X" "g t0 = x0"
shows "g ∈ iter_space"
using assms
by (simp add: iter_space_def mem_PiC_iff Pi_iff)
lemma iter_spaceD:
assumes "g ∈ iter_space"
shows "g ∈ T →⇩C X" "apply_bcontfun g t0 = x0"
using assms iv_defined
by (auto simp add: iter_space_def mem_PiC_iff split: if_splits)
lemma const_in_iter_space: "const_bcontfun x0 ∈ iter_space"
by (auto simp: iter_space_def iv_defined mem_PiC_iff)
lemma closed_iter_space: "closed iter_space"
by (auto simp: iter_space_def intro!: closed_PiC closed)
lemma iter_space_notempty: "iter_space ≠ {}"
using const_in_iter_space by blast
lemma clamp_in_eq[simp]: fixes a x b::real shows "a ≤ x ⟹ x ≤ b ⟹ clamp a b x = x"
by (auto simp: clamp_def)
lemma P_self_mapping:
assumes in_space: "g ∈ iter_space"
shows "P g ∈ iter_space"
proof (rule iter_spaceI)
show x0: "P g t0 = x0"
by (auto simp: P_def' iv_defined iter_spaceD[OF in_space])
from iter_spaceD(1)[OF in_space] show "P g ∈ T →⇩C X"
unfolding mem_PiC_iff Pi_iff
apply (auto simp: mem_PiC_iff Pi_iff P_def')
apply (auto simp: iter_spaceD(2)[OF in_space, symmetric] intro!: self_mapping)
using closed_segment_subset_domainI iv_defined(1) by blast
qed
lemma continuous_on_T: "continuous_on {tmin .. tmax} g ⟹ continuous_on T g"
using T_def by auto
lemma T_closed_segment_subsetI[intro, simp]: "t ∈ {tmin--tmax} ⟹ t ∈ T"
and T_subsetI[intro, simp]: "tmin ≤ t ⟹ t ≤ tmax ⟹ t ∈ T"
by (subst T_def, simp add: closed_segment_eq_real_ivl)+
lemma t0_mem_closed_segment[intro, simp]: "t0 ∈ {tmin--tmax}"
using T_def iv_defined
by (simp add: closed_segment_eq_real_ivl)
lemma tmin_le_t0[intro, simp]: "tmin ≤ t0"
and tmax_ge_t0[intro, simp]: "tmax ≥ t0"
using t0_mem_closed_segment
unfolding closed_segment_eq_real_ivl
by simp_all
lemma apply_bcontfun_solution_fixed_point:
assumes ode: "(apply_bcontfun x solves_ode f) T X"
assumes iv: "x t0 = x0"
assumes t: "t ∈ T"
shows "P x t = x t"
proof -
have "t ∈ {t0 -- t}" by simp
have ode': "(apply_bcontfun x solves_ode f) {t0--t} X" "t ∈ {t0 -- t}"
using ode T_def closed_segment_eq_real_ivl t apply auto
using closed_segment_iv_subset_domain solves_ode_on_subset apply fastforce
using closed_segment_iv_subset_domain solves_ode_on_subset apply fastforce
done
from solves_odeD[OF ode]
have x: "x ∈ T →⇩C X" by (auto simp: mem_PiC_iff)
from solution_fixed_point[OF ode'] iv
show ?thesis
unfolding P_def'[OF t x]
by simp
qed
lemma
solution_in_iter_space:
assumes ode: "(apply_bcontfun z solves_ode f) T X"
assumes iv: "z t0 = x0"
shows "z ∈ iter_space" (is "?z ∈ _")
proof -
from T_def ode have ode: "(z solves_ode f) {tmin -- tmax} X"
by (simp add: closed_segment_eq_real_ivl)
have "(?z solves_ode f) T X"
using is_solution_ext_cont[OF solves_ode_continuous_on[OF ode], of f X] ode T_def
by (auto simp: min_def max_def closed_segment_eq_real_ivl)
then have "z ∈ T →⇩C X"
by (auto simp add: solves_ode_def mem_PiC_iff)
thus "?z ∈ iter_space"
by (auto simp: iv intro!: iter_spaceI)
qed
end
locale unique_on_bounded_closed = unique_on_closed +
assumes lipschitz_bound: "⋀s t. s ∈ T ⟹ t ∈ T ⟹ abs (s - t) * L < 1"
begin
lemma lipschitz_bound_maxmin: "(tmax - tmin) * L < 1"
using lipschitz_bound[of tmax tmin]
by auto
lemma lipschitz_P:
shows "((tmax - tmin) * L)-lipschitz_on iter_space P"
proof (rule lipschitz_onI)
have "t0 ∈ T" by (simp add: iv_defined)
then show "0 ≤ (tmax - tmin) * L"
using T_def
by (auto intro!: mult_nonneg_nonneg lipschitz lipschitz_on_nonneg[OF lipschitz]
iv_defined)
fix y z
assume "y ∈ iter_space" and "z ∈ iter_space"
hence y_defined: "y ∈ (T →⇩C X)" and "y t0 = x0"
and z_defined: "z ∈ (T →⇩C X)" and "y t0 = x0"
by (auto dest: iter_spaceD)
have defined: "s ∈ T" "y s ∈ X" "z s ∈ X" if "s ∈ closed_segment tmin tmax" for s
using y_defined z_defined that T_def
by (auto simp: mem_PiC_iff)
{
note [intro, simp] = integrable_continuous_closed_segment
fix t
assume t_bounds: "tmin ≤ t" "t ≤ tmax"
then have cs_subs: "closed_segment t0 t ⊆ closed_segment tmin tmax"
by (auto simp: closed_segment_eq_real_ivl)
then have cs_subs_ext: "⋀ta. ta ∈ {t0--t} ⟹ ta ∈ {tmin--tmax}" by auto
have "norm (P_inner y t - P_inner z t) =
norm (ivl_integral t0 t (λt. f t (y t) - f t (z t)))"
by (subst ivl_integral_diff)
(auto intro!: integrable_continuous_closed_segment continuous_intros defined cs_subs_ext simp: P_inner_def)
also have "... ≤ abs (ivl_integral t0 t (λt. norm (f t (y t) - f t (z t))))"
by (rule ivl_integral_norm_bound_ivl_integral)
(auto intro!: ivl_integral_norm_bound_ivl_integral continuous_intros integrable_continuous_closed_segment
simp: defined cs_subs_ext)
also have "... ≤ abs (ivl_integral t0 t (λt. L * norm (y t - z t)))"
using lipschitz t_bounds T_def y_defined z_defined cs_subs
by (intro norm_ivl_integral_le) (auto intro!: continuous_intros integrable_continuous_closed_segment
simp add: dist_norm lipschitz_on_def mem_PiC_iff Pi_iff)
also have "... ≤ abs (ivl_integral t0 t (λt. L * norm (y - z)))"
using norm_bounded[of "y - z"]
L_nonneg
by (intro norm_ivl_integral_le) (auto intro!: continuous_intros mult_left_mono)
also have "... = L * abs (t - t0) * norm (y - z)"
using t_bounds L_nonneg by (simp add: abs_mult)
also have "... ≤ L * (tmax - tmin) * norm (y - z)"
using t_bounds zero_le_dist L_nonneg cs_subs tmin_le_t0 tmax_ge_t0
by (auto intro!: mult_right_mono mult_left_mono simp: closed_segment_eq_real_ivl abs_real_def
simp del: tmin_le_t0 tmax_ge_t0 split: if_split_asm)
finally
have "dist (P_inner y t) (P_inner z t) ≤ (tmax - tmin) * L * dist y z"
by (simp add: dist_norm ac_simps)
} note * = this
show "dist (P y) (P z) ≤ (tmax - tmin) * L * dist y z"
by (auto intro!: dist_bound dist_P_le * y_defined z_defined mult_nonneg_nonneg L_nonneg)
qed
lemma fixed_point_unique: "∃!x∈iter_space. P x = x"
using lipschitz lipschitz_bound_maxmin lipschitz_P T_def
complete_UNIV iv_defined
by (intro banach_fix)
(auto
intro: P_self_mapping split_mult_pos_le
intro!: closed_iter_space iter_space_notempty mult_nonneg_nonneg
simp: lipschitz_on_def complete_eq_closed)
definition fixed_point where
"fixed_point = (THE x. x ∈ iter_space ∧ P x = x)"
lemma fixed_point':
"fixed_point ∈ iter_space ∧ P fixed_point = fixed_point"
unfolding fixed_point_def using fixed_point_unique
by (rule theI')
lemma fixed_point:
"fixed_point ∈ iter_space" "P fixed_point = fixed_point"
using fixed_point' by simp_all
lemma fixed_point_equality': "x ∈ iter_space ∧ P x = x ⟹ fixed_point = x"
unfolding fixed_point_def using fixed_point_unique
by (rule the1_equality)
lemma fixed_point_equality: "x ∈ iter_space ⟹ P x = x ⟹ fixed_point = x"
using fixed_point_equality'[of x] by auto
lemma fixed_point_iv: "fixed_point t0 = x0"
and fixed_point_domain: "x ∈ T ⟹ fixed_point x ∈ X"
using fixed_point
by (force dest: iter_spaceD simp: mem_PiC_iff)+
lemma fixed_point_has_vderiv_on: "(fixed_point has_vderiv_on (λt. f t (fixed_point t))) T"
proof -
have "continuous_on T (λx. f x (fixed_point x))"
using fixed_point_domain
by (auto intro!: continuous_intros)
then have "((λu. x0 + ivl_integral t0 u (λx. f x (fixed_point x))) has_vderiv_on (λt. f t (fixed_point t))) T"
by (auto intro!: derivative_intros ivl_integral_has_vderiv_on_compact_interval interval compact_time)
then show ?thesis
proof (rule has_vderiv_eq)
fix t
assume t: "t ∈ T"
have "fixed_point t = P fixed_point t"
using fixed_point by simp
also have "… = x0 + ivl_integral t0 t (λx. f x (fixed_point x))"
using t fixed_point_domain
by (auto simp: P_def' mem_PiC_iff)
finally show "x0 + ivl_integral t0 t (λx. f x (fixed_point x)) = fixed_point t" by simp
qed (insert T_def, auto simp: closed_segment_eq_real_ivl)
qed
lemma fixed_point_solution:
shows "(fixed_point solves_ode f) T X"
using fixed_point_has_vderiv_on fixed_point_domain
by (rule solves_odeI)
subsubsection ‹Unique solution›
text‹\label{sec:ivp-ubs}›
lemma solves_ode_equals_fixed_point:
assumes ode: "(x solves_ode f) T X"
assumes iv: "x t0 = x0"
assumes t: "t ∈ T"
shows "x t = fixed_point t"
proof -
from solves_ode_continuous_on[OF ode] T_def
have "continuous_on (cbox tmin tmax) x" by simp
from continuous_on_cbox_bcontfunE[OF this]
obtain g where g:
"t ∈ {tmin .. tmax} ⟹ apply_bcontfun g t = x t"
"apply_bcontfun g t = x (clamp tmin tmax t)"
for t
by (metis interval_cbox)
with ode T_def have ode_g: "(g solves_ode f) T X"
by (metis (no_types, lifting) solves_ode_cong)
have "x t = g t"
using t T_def
by (intro g[symmetric]) auto
also
have "g t0 = x0" "g ∈ T →⇩C X"
using iv g solves_odeD(2)[OF ode_g]
unfolding mem_PiC_iff atLeastAtMost_iff
by blast+
then have "g ∈ iter_space"
by (intro iter_spaceI)
then have "g = fixed_point"
apply (rule fixed_point_equality[symmetric])
apply (rule bcontfun_eqI)
subgoal for t
using apply_bcontfun_solution_fixed_point[OF ode_g ‹g t0 = x0›, of tmin]
apply_bcontfun_solution_fixed_point[OF ode_g ‹g t0 = x0›, of tmax]
apply_bcontfun_solution_fixed_point[OF ode_g ‹g t0 = x0›, of t]
using T_def
by (fastforce simp: P_eqs not_le ‹g ∈ T →⇩C X› g)
done
finally show ?thesis .
qed
lemma solves_ode_on_closed_segment_equals_fixed_point:
assumes ode: "(x solves_ode f) {t0 -- t1'} X"
assumes iv: "x t0 = x0"
assumes subset: "{t0--t1'} ⊆ T"
assumes t_mem: "t ∈ {t0--t1'}"
shows "x t = fixed_point t"
proof -
have subsetI: "t ∈ {t0--t1'} ⟹ t ∈ T" for t
using subset by auto
interpret s: unique_on_bounded_closed t0 "{t0--t1'}" x0 f X L
apply - apply unfold_locales
subgoal by (simp add: closed_segment_eq_real_ivl)
subgoal by simp
subgoal by simp
subgoal by simp
subgoal using iv_defined by simp
subgoal by (intro self_mapping subsetI)
subgoal by (rule continuous_on_subset[OF continuous]) (auto simp: subsetI )
subgoal by (rule lipschitz) (auto simp: subsetI)
subgoal by (auto intro!: subsetI lipschitz_bound)
done
have "x t = s.fixed_point t"
by (rule s.solves_ode_equals_fixed_point; fact)
moreover
have "fixed_point t = s.fixed_point t"
by (intro s.solves_ode_equals_fixed_point solves_ode_on_subset[OF fixed_point_solution] assms
fixed_point_iv order_refl subset t_mem)
ultimately show ?thesis by simp
qed
lemma unique_solution:
assumes ivp1: "(x solves_ode f) T X" "x t0 = x0"
assumes ivp2: "(y solves_ode f) T X" "y t0 = x0"
assumes "t ∈ T"
shows "x t = y t"
using solves_ode_equals_fixed_point[OF ivp1 ‹t ∈ T›]
solves_ode_equals_fixed_point[OF ivp2 ‹t ∈ T›]
by simp
lemma fixed_point_usolves_ode: "(fixed_point usolves_ode f from t0) T X"
apply (rule usolves_odeI[OF fixed_point_solution])
subgoal by (simp add: iv_defined(1))
subgoal by (rule interval)
subgoal
using fixed_point_iv solves_ode_on_closed_segment_equals_fixed_point
by auto
done
end
lemma closed_segment_Un:
fixes a b c::real
assumes "b ∈ closed_segment a c"
shows "closed_segment a b ∪ closed_segment b c = closed_segment a c"
using assms
by (auto simp: closed_segment_eq_real_ivl)
lemma closed_segment_closed_segment_subset:
fixes s::real and i::nat
assumes "s ∈ closed_segment a b"
assumes "a ∈ closed_segment c d" "b ∈ closed_segment c d"
shows "s ∈ closed_segment c d"
using assms
by (auto simp: closed_segment_eq_real_ivl split: if_split_asm)
context unique_on_closed begin
context
fixes t1::real
assumes mem_t1: "t1 ∈ T"
begin
lemma subdivide_count_ex: "∃n. L * abs (t1 - t0) / (Suc n) < 1"
by auto (meson add_strict_increasing less_numeral_extra(1) real_arch_simple)
definition "subdivide_count = (SOME n. L * abs (t1 - t0) / Suc n < 1)"
lemma subdivide_count: "L * abs (t1 - t0) / Suc subdivide_count < 1"
unfolding subdivide_count_def
using subdivide_count_ex
by (rule someI_ex)
lemma subdivide_lipschitz:
assumes "¦s - t¦ ≤ abs (t1 - t0) / Suc subdivide_count"
shows "¦s - t¦ * L < 1"
proof -
from assms L_nonneg
have "¦s - t¦ * L ≤ abs (t1 - t0) / Suc subdivide_count * L"
by (rule mult_right_mono)
also have "… < 1"
using subdivide_count
by (simp add: ac_simps)
finally show ?thesis .
qed
lemma subdivide_lipschitz_lemma:
assumes st: "s ∈ {a -- b}" "t ∈ {a -- b}"
assumes "abs (b - a) ≤ abs (t1 - t0) / Suc subdivide_count"
shows "¦s - t¦ * L < 1"
apply (rule subdivide_lipschitz)
apply (rule order_trans[where y="abs (b - a)"])
using assms
by (auto simp: closed_segment_eq_real_ivl split: if_splits)
definition "step = (t1 - t0) / Suc subdivide_count"
lemma last_step: "t0 + real (Suc subdivide_count) * step = t1"
by (auto simp: step_def)
lemma step_in_segment:
assumes "0 ≤ i" "i ≤ real (Suc subdivide_count)"
shows "t0 + i * step ∈ closed_segment t0 t1"
unfolding closed_segment_eq_real_ivl step_def
proof (clarsimp, safe)
assume "t0 ≤ t1"
then have "(t1 - t0) * i ≤ (t1 - t0) * (1 + subdivide_count)"
using assms
by (auto intro!: mult_left_mono)
then show "t0 + i * (t1 - t0) / (1 + real subdivide_count) ≤ t1"
by (simp add: field_simps)
next
assume "¬t0 ≤ t1"
then have "(1 + subdivide_count) * (t0 - t1) ≥ i * (t0 - t1)"
using assms
by (auto intro!: mult_right_mono)
then show "t1 ≤ t0 + i * (t1 - t0) / (1 + real subdivide_count)"
by (simp add: field_simps)
show "i * (t1 - t0) / (1 + real subdivide_count) ≤ 0"
using ‹¬t0 ≤ t1›
by (auto simp: divide_simps mult_le_0_iff assms)
qed (auto intro!: divide_nonneg_nonneg mult_nonneg_nonneg assms)
lemma subset_T1:
fixes s::real and i::nat
assumes "s ∈ closed_segment t0 (t0 + i * step)"
assumes "i ≤ Suc subdivide_count"
shows "s ∈ {t0 -- t1}"
using closed_segment_closed_segment_subset assms of_nat_le_iff of_nat_0_le_iff step_in_segment
by blast
lemma subset_T: "{t0 -- t1} ⊆ T" and subset_TI: "s ∈ {t0 -- t1} ⟹ s ∈ T"
using closed_segment_iv_subset_domain mem_t1 by blast+
primrec psolution::"nat ⇒ real ⇒ 'a" where
"psolution 0 t = x0"
| "psolution (Suc i) t = unique_on_bounded_closed.fixed_point
(t0 + real i * step) {t0 + real i * step -- t0 + real (Suc i) * step}
(psolution i (t0 + real i * step)) f X t"
definition "psolutions t = psolution (LEAST i. t ∈ closed_segment (t0 + real (i - 1) * step) (t0 + real i * step)) t"
lemma psolutions_usolves_until_step:
assumes i_le: "i ≤ Suc subdivide_count"
shows "(psolutions usolves_ode f from t0) (closed_segment t0 (t0 + real i * step)) X"
proof cases
assume "t0 = t1"
then have "step = 0"
unfolding step_def by simp
then show ?thesis by (simp add: psolutions_def iv_defined usolves_ode_singleton)
next
assume "t0 ≠ t1"
then have "step ≠ 0"
by (simp add: step_def)
define S where "S ≡ λi. closed_segment (t0 + real (i - 1) * step) (t0 + real i * step)"
have solution_eq: "psolutions ≡ λt. psolution (LEAST i. t ∈ S i) t"
by (simp add: psolutions_def[abs_def] S_def)
show ?thesis
unfolding solution_eq
using i_le
proof (induction i)
case 0 then show ?case by (simp add: iv_defined usolves_ode_singleton S_def)
next
case (Suc i)
let ?sol = "λt. psolution (LEAST i. t ∈ S i) t"
let ?pi = "t0 + real (i - Suc 0) * step" and ?i = "t0 + real i * step" and ?si = "t0 + (1 + real i) * step"
from Suc have ui: "(?sol usolves_ode f from t0) (closed_segment t0 (t0 + real i * step)) X"
by simp
from usolves_odeD(1)[OF Suc.IH] Suc
have IH_sol: "(?sol solves_ode f) (closed_segment t0 ?i) X"
by simp
have Least_eq_t0[simp]: "(LEAST n. t0 ∈ S n) = 0"
by (rule Least_equality) (auto simp add: S_def)
have Least_eq[simp]: "(LEAST n. t0 + real i * step ∈ S n) = i" for i
apply (rule Least_equality)
subgoal by (simp add: S_def)
subgoal
using ‹step ≠ 0›
by (cases "step ≥ 0")
(auto simp add: S_def closed_segment_eq_real_ivl zero_le_mult_iff split: if_split_asm)
done
have "y = t0 + real i * s"
if "t0 + (1 + real i) * s ≤ t" "t ≤ y" "y ≤ t0 + real i * s" "t0 ≤ y"
for y i s t
proof -
from that have "(1 + real i) * s ≤ real i * s" "0 ≤ real i * s"
by arith+
have "s + (t0 + s * real i) ≤ t ⟹ t ≤ y ⟹ y ≤ t0 + s * real i ⟹ t0 ≤ y ⟹ y = t0 + s * real i"
by (metis add_decreasing2 eq_iff le_add_same_cancel2 linear mult_le_0_iff of_nat_0_le_iff order.trans)
then show ?thesis using that
by (simp add: algebra_simps)
qed
then have segment_inter:
"xa = t0 + real i * step"
if
"t ∈ {t0 + real (Suc i - 1) * step--t0 + real (Suc i) * step}"
"xa ∈ closed_segment (t0 + real i * step) t" "xa ∈ closed_segment t0 (t0 + real i * step)"
for xa t
apply (cases "step > 0"; cases "step = 0")
using that
by (auto simp: S_def closed_segment_eq_real_ivl split: if_split_asm)
have right_cond: "t0 ≤ t" "t ≤ t1" if "t0 + real i * step ≤ t" "t ≤ t0 + (step + real i * step)" for t
proof -
from that have "0 ≤ step" by simp
with last_step have "t0 ≤ t1"
by (metis le_add_same_cancel1 of_nat_0_le_iff zero_le_mult_iff)
from that have "t0 ≤ t - real i * step" by simp
also have "… ≤ t" using that by (auto intro!: mult_nonneg_nonneg)
finally show "t0 ≤ t" .
have "t ≤ t0 + (real (Suc i) * step)" using that by (simp add: algebra_simps)
also have "… ≤ t1"
proof -
have "real (Suc i) * (t1 - t0) ≤ real (Suc subdivide_count) * (t1 - t0)"
using Suc.prems ‹t0 ≤ t1›
by (auto intro!: mult_mono)
then show ?thesis by (simp add: divide_simps algebra_simps step_def)
qed
finally show "t ≤ t1" .
qed
have left_cond: "t1 ≤ t" "t ≤ t0" if "t0 + (step + real i * step) ≤ t" "t ≤ t0 + real i * step" for t
proof -
from that have "step ≤ 0" by simp
with last_step have "t1 ≤ t0"
by (metis add_le_same_cancel1 mult_nonneg_nonpos of_nat_0_le_iff)
from that have "t0 ≥ t - real i * step" by simp
also have "t - real i * step ≥ t" using that by (auto intro!: mult_nonneg_nonpos)
finally (xtrans) show "t ≤ t0" .
have "t ≥ t0 + (real (Suc i) * step)" using that by (simp add: algebra_simps)
also have " t0 + (real (Suc i) * step) ≥ t1"
proof -
have "real (Suc i) * (t0 - t1) ≤ real (Suc subdivide_count) * (t0 - t1)"
using Suc.prems ‹t0 ≥ t1›
by (auto intro!: mult_mono)
then show ?thesis by (simp add: divide_simps algebra_simps step_def)
qed
finally (xtrans) show "t1 ≤ t" .
qed
interpret l: self_mapping "S (Suc i)" ?i "?sol ?i" f X
proof unfold_locales
show "?sol ?i ∈ X"
using solves_odeD(2)[OF usolves_odeD(1)[OF ui], of "?i"]
by (simp add: S_def)
fix x t assume t[unfolded S_def]: "t ∈ S (Suc i)"
and x: "x ?i = ?sol ?i" "x ∈ closed_segment ?i t → X"
and cont: "continuous_on (closed_segment ?i t) x"
let ?if = "λt. if t ∈ closed_segment t0 ?i then ?sol t else x t"
let ?f = "λt. f t (?if t)"
have sol_mem: "?sol s ∈ X" if "s ∈ closed_segment t0 ?i" for s
by (auto simp: subset_T1 intro!: solves_odeD[OF IH_sol] that)
from x(1) have "x ?i + ivl_integral ?i t (λt. f t (x t)) = ?sol ?i + ivl_integral ?i t (λt. f t (x t))"
by simp
also have "?sol ?i = ?sol t0 + ivl_integral t0 ?i (λt. f t (?sol t))"
apply (subst solution_fixed_point)
apply (rule usolves_odeD[OF ui])
by simp_all
also have "ivl_integral t0 ?i (λt. f t (?sol t)) = ivl_integral t0 ?i ?f"
by (simp cong: ivl_integral_cong)
also
have psolution_eq: "x (t0 + real i * step) = psolution i (t0 + real i * step) ⟹
ta ∈ {t0 + real i * step--t} ⟹
ta ∈ {t0--t0 + real i * step} ⟹ psolution (LEAST i. ta ∈ S i) ta = x ta" for ta
by (subst segment_inter[OF t], assumption, assumption)+ simp
have "ivl_integral ?i t (λt. f t (x t)) = ivl_integral ?i t ?f"
by (rule ivl_integral_cong) (simp_all add: x psolution_eq)
also
from t right_cond(1) have cs: "closed_segment t0 t = closed_segment t0 ?i ∪ closed_segment ?i t"
by (intro closed_segment_Un[symmetric])
(auto simp: closed_segment_eq_real_ivl algebra_simps mult_le_0_iff split: if_split_asm
intro!: segment_inter segment_inter[symmetric])
have cont_if: "continuous_on (closed_segment t0 t) ?if"
unfolding cs
using x Suc.prems cont t psolution_eq
by (auto simp: subset_T1 T_def intro!: continuous_on_cases solves_ode_continuous_on[OF IH_sol])
have t_mem: "t ∈ closed_segment t0 t1"
using x Suc.prems t
apply -
apply (rule closed_segment_closed_segment_subset, assumption)
apply (rule step_in_segment, force, force)
apply (rule step_in_segment, force, force)
done
have segment_subset: "ta ∈ {t0 + real i * step--t} ⟹ ta ∈ {t0--t1}" for ta
using x Suc.prems
apply -
apply (rule closed_segment_closed_segment_subset, assumption)
subgoal by (rule step_in_segment; force)
subgoal by (rule t_mem)
done
have cont_f: "continuous_on (closed_segment t0 t) ?f"
apply (rule continuous_intros)
apply (rule continuous_intros)
apply (rule cont_if)
unfolding cs
using x Suc.prems
apply (auto simp: subset_T1 segment_subset intro!: sol_mem subset_TI)
done
have "?sol t0 + ivl_integral t0 ?i ?f + ivl_integral ?i t ?f = ?if t0 + ivl_integral t0 t ?f"
by (auto simp: cs intro!: ivl_integral_combine integrable_continuous_closed_segment
continuous_on_subset[OF cont_f])
also have "… ∈ X"
apply (rule self_mapping)
apply (rule subset_TI)
apply (rule t_mem)
using x cont_if
by (auto simp: subset_T1 Pi_iff cs intro!: sol_mem)
finally
have "x ?i + ivl_integral ?i t (λt. ?f t) ∈ X" .
also have "ivl_integral ?i t (λt. ?f t) = ivl_integral ?i t (λt. f t (x t))"
apply (rule ivl_integral_cong[OF _ refl refl])
using x
by (auto simp: segment_inter psolution_eq)
finally
show "x ?i + ivl_integral ?i t (λt. f t (x t)) ∈ X" .
qed (auto simp add: S_def closed_segment_eq_real_ivl)
have "S (Suc i) ⊆ T"
unfolding S_def
apply (rule subsetI)
apply (rule subset_TI)
proof (cases "step = 0")
case False
fix x assume x: "x ∈ {t0 + real (Suc i - 1) * step--t0 + real (Suc i) * step}"
from x have nn: "((x - t0) / step) ≥ 0"
using False right_cond(1)[of x] left_cond(2)[of x]
by (auto simp: closed_segment_eq_real_ivl divide_simps algebra_simps split: if_splits)
have "t1 < t0 ⟹ t1 ≤ x" "t1 > t0 ⟹ x ≤ t1"
using x False right_cond(1,2)[of x] left_cond(1,2)[of x]
by (auto simp: closed_segment_eq_real_ivl algebra_simps split: if_splits)
then have le: "(x - t0) / step ≤ 1 + real subdivide_count"
unfolding step_def
by (auto simp: divide_simps)
have "x = t0 + ((x - t0) / step) * step"
using False
by auto
also have "… ∈ {t0 -- t1}"
by (rule step_in_segment) (auto simp: nn le)
finally show "x ∈ {t0 -- t1}" by simp
qed simp
have algebra: "(1 + real i) * (t1 - t0) - real i * (t1 - t0) = t1 - t0"
by (simp only: algebra_simps)
interpret l: unique_on_bounded_closed ?i "S (Suc i)" "?sol ?i" f X L
apply unfold_locales
subgoal by (auto simp: S_def)
subgoal using ‹S (Suc i) ⊆ T› by (auto intro!: continuous_intros simp: split_beta')
subgoal using ‹S (Suc i) ⊆ T› by (auto intro!: lipschitz)
subgoal by (rule subdivide_lipschitz_lemma) (auto simp add: step_def divide_simps algebra S_def)
done
note ui
moreover
have mem_SI: "t ∈ closed_segment ?i ?si ⟹ t ∈ S (if t = ?i then i else Suc i)" for t
by (auto simp: S_def)
have min_S: "(if t = t0 + real i * step then i else Suc i) ≤ y"
if "t ∈ closed_segment (t0 + real i * step) (t0 + (1 + real i) * step)"
"t ∈ S y"
for y t
apply (cases "t = t0 + real i * step")
subgoal using that ‹step ≠ 0›
by (auto simp add: S_def closed_segment_eq_real_ivl algebra_simps zero_le_mult_iff split: if_splits )
subgoal premises ne
proof (cases)
assume "step > 0"
with that have "t0 + real i * step ≤ t" "t ≤ t0 + (1 + real i) * step"
"t0 + real (y - Suc 0) * step ≤ t" "t ≤ t0 + real y * step"
by (auto simp: closed_segment_eq_real_ivl S_def)
then have "real i * step < real y * step" using ‹step > 0› ne
by arith
then show ?thesis using ‹step > 0› that by (auto simp add: closed_segment_eq_real_ivl S_def)
next
assume "¬ step > 0" with ‹step ≠ 0› have "step < 0" by simp
with that have "t0 + (1 + real i) * step ≤ t" "t ≤ t0 + real i * step"
"t0 + real y * step ≤ t" "t ≤ t0 + real (y - Suc 0) * step" using ne
by (auto simp: closed_segment_eq_real_ivl S_def diff_Suc zero_le_mult_iff split: if_splits nat.splits)
then have "real y * step < real i * step"
using ‹step < 0› ne
by arith
then show ?thesis using ‹step < 0› by (auto simp add: closed_segment_eq_real_ivl S_def)
qed
done
have "(?sol usolves_ode f from ?i) (closed_segment ?i ?si) X"
apply (subst usolves_ode_cong)
apply (subst Least_equality)
apply (rule mem_SI) apply assumption
apply (rule min_S) apply assumption apply assumption
apply (rule refl)
apply (rule refl)
apply (rule refl)
apply (rule refl)
apply (rule refl)
apply (subst usolves_ode_cong[where y="psolution (Suc i)"])
using l.fixed_point_iv[unfolded Least_eq]
apply (simp add: S_def; fail)
apply (rule refl)
apply (rule refl)
apply (rule refl)
apply (rule refl)
using l.fixed_point_usolves_ode
apply -
apply (simp)
apply (simp add: S_def)
done
moreover have "t ∈ {t0 + real i * step--t0 + (step + real i * step)} ⟹
t ∈ {t0--t0 + real i * step} ⟹ t = t0 + real i * step" for t
by (subst segment_inter[rotated], assumption, assumption) (auto simp: algebra_simps)
ultimately
have "((λt. if t ∈ closed_segment t0 ?i then ?sol t else ?sol t)
usolves_ode
(λt. if t ∈ closed_segment t0 ?i then f t else f t) from t0)
(closed_segment t0 ?i ∪ closed_segment ?i ?si) X"
by (intro connection_usolves_ode[where t="?i"]) (auto simp: algebra_simps split: if_split_asm)
also have "closed_segment t0 ?i ∪ closed_segment ?i ?si = closed_segment t0 ?si"
apply (rule closed_segment_Un)
by (cases "step < 0")
(auto simp: closed_segment_eq_real_ivl zero_le_mult_iff mult_le_0_iff
intro!: mult_right_mono
split: if_split_asm)
finally show ?case by simp
qed
qed
lemma psolutions_usolves_ode: "(psolutions usolves_ode f from t0) {t0 -- t1} X"
proof -
let ?T = "closed_segment t0 (t0 + real (Suc subdivide_count) * step)"
have "(psolutions usolves_ode f from t0) ?T X"
by (rule psolutions_usolves_until_step) simp
also have "?T = {t0 -- t1}" unfolding last_step ..
finally show ?thesis .
qed
end
definition "solution t = (if t ≤ t0 then psolutions tmin t else psolutions tmax t)"
lemma solution_eq_left: "tmin ≤ t ⟹ t ≤ t0 ⟹ solution t = psolutions tmin t"
by (simp add: solution_def)
lemma solution_eq_right: "t0 ≤ t ⟹ t ≤ tmax ⟹ solution t = psolutions tmax t"
by (simp add: solution_def psolutions_def)
lemma solution_usolves_ode: "(solution usolves_ode f from t0) T X"
proof -
from psolutions_usolves_ode[OF tmin(2)] tmin_le_t0
have u1: "(psolutions tmin usolves_ode f from t0) {tmin .. t0} X"
by (auto simp: closed_segment_eq_real_ivl split: if_splits)
from psolutions_usolves_ode[OF tmax(2)] tmin_le_t0
have u2: "(psolutions tmax usolves_ode f from t0) {t0 .. tmax} X"
by (auto simp: closed_segment_eq_real_ivl split: if_splits)
have "(solution usolves_ode f from t0) ({tmin .. t0} ∪ {t0 .. tmax}) (X ∪ X)"
apply (rule usolves_ode_union_closed[where t=t0])
subgoal by (subst usolves_ode_cong[where y="psolutions tmin"]) (auto simp: solution_eq_left u1)
subgoal
using u2
by (rule usolves_ode_congI) (auto simp: solution_eq_right)
subgoal by simp
subgoal by simp
subgoal by simp
done
also have "{tmin .. t0} ∪ {t0 .. tmax} = T"
by (simp add: T_split[symmetric])
finally show ?thesis by simp
qed
lemma solution_solves_ode: "(solution solves_ode f) T X"
by (rule usolves_odeD[OF solution_usolves_ode])
lemma solution_iv[simp]: "solution t0 = x0"
by (auto simp: solution_def psolutions_def)
end
subsection ‹Picard-Lindeloef for @{term "X = UNIV"}›
text‹\label{sec:pl-us}›
locale unique_on_strip =
compact_interval T +
continuous_rhs T UNIV f +
global_lipschitz T UNIV f L
for t0 and T and f::"real ⇒ 'a ⇒ 'a::banach" and L +
assumes iv_time: "t0 ∈ T"
begin
sublocale unique_on_closed t0 T x0 f UNIV L for x0
by (-, unfold_locales) (auto simp: iv_time)
end
subsection ‹Picard-Lindeloef on cylindric domain›
text‹\label{sec:pl-rect}›
locale solution_in_cylinder =
continuous_rhs T "cball x0 b" f +
compact_interval T
for t0 T x0 b and f::"real ⇒ 'a ⇒ 'a::banach" +
fixes X B
defines "X ≡ cball x0 b"
assumes initial_time_in: "t0 ∈ T"
assumes norm_f: "⋀x t. t ∈ T ⟹ x ∈ X ⟹ norm (f t x) ≤ B"
assumes b_pos: "b ≥ 0"
assumes e_bounded: "⋀t. t ∈ T ⟹ dist t t0 ≤ b / B"
begin
lemmas cylinder = X_def
lemma B_nonneg: "B ≥ 0"
proof -
have "0 ≤ norm (f t0 x0)" by simp
also from b_pos norm_f have "... ≤ B" by (simp add: initial_time_in X_def)
finally show ?thesis by simp
qed
lemma in_bounds_derivativeI:
assumes "t ∈ T"
assumes init: "x t0 = x0"
assumes cont: "continuous_on (closed_segment t0 t) x"
assumes solves: "(x has_vderiv_on (λs. f s (y s))) (open_segment t0 t)"
assumes y_bounded: "⋀ξ. ξ ∈ closed_segment t0 t ⟹ x ξ ∈ X ⟹ y ξ ∈ X"
shows "x t ∈ cball x0 (B * abs (t - t0))"
proof cases
assume "b = 0 ∨ B = 0" with assms e_bounded T_def have "t = t0"
by auto
thus ?thesis using b_pos init by simp
next
assume "¬(b = 0 ∨ B = 0)"
hence "b > 0" "B > 0" using B_nonneg b_pos by auto
show ?thesis
proof cases
assume "t0 ≠ t"
then have b_less: "B * abs (t - t0) ≤ b"
using b_pos e_bounded using ‹b > 0› ‹B > 0› ‹t ∈ T›
by (auto simp: field_simps initial_time_in dist_real_def abs_real_def closed_segment_eq_real_ivl split: if_split_asm)
define b where "b ≡ B * abs (t - t0)"
have "b > 0" using ‹t0 ≠ t› by (auto intro!: mult_pos_pos simp: algebra_simps b_def ‹B > 0›)
from cont
have closed: "closed (closed_segment t0 t ∩ ((λs. norm (x s - x t0)) -` {b..}))"
by (intro continuous_closed_preimage continuous_intros closed_segment)
have exceeding: "{s ∈ closed_segment t0 t. norm (x s - x t0) ∈ {b..}} ⊆ {t}"
proof (rule ccontr)
assume "¬{s ∈ closed_segment t0 t. norm (x s - x t0) ∈ {b..}} ⊆ {t}"
hence notempty: "(closed_segment t0 t ∩ ((λs. norm (x s - x t0)) -` {b..})) ≠ {}"
and not_max: "{s ∈ closed_segment t0 t. norm (x s - x t0) ∈ {b..}} ≠ {t}"
by auto
obtain s where s_bound: "s ∈ closed_segment t0 t"
and exceeds: "norm (x s - x t0) ∈ {b..}"
and min: "∀t2∈closed_segment t0 t.
norm (x t2 - x t0) ∈ {b..} ⟶ dist t0 s ≤ dist t0 t2"
by (rule distance_attains_inf[OF closed notempty, of t0]) blast
have "s ≠ t0" using exceeds ‹b > 0› by auto
have st: "closed_segment t0 t ⊇ open_segment t0 s" using s_bound
by (auto simp: closed_segment_eq_real_ivl open_segment_eq_real_ivl)
from cont have cont: "continuous_on (closed_segment t0 s) x"
by (rule continuous_on_subset)
(insert b_pos closed_segment_subset_domain s_bound, auto simp: closed_segment_eq_real_ivl)
have bnd_cont: "continuous_on (closed_segment t0 s) ((*) B)"
and bnd_deriv: "((*) B has_vderiv_on (λ_. B)) (open_segment t0 s)"
by (auto intro!: continuous_intros derivative_eq_intros
simp: has_vector_derivative_def has_vderiv_on_def)
{
fix ss assume ss: "ss ∈ open_segment t0 s"
with st have "ss ∈ closed_segment t0 t" by auto
have less_b: "norm (x ss - x t0) < b"
proof (rule ccontr)
assume "¬ norm (x ss - x t0) < b"
hence "norm (x ss - x t0) ∈ {b..}" by auto
from min[rule_format, OF ‹ss ∈ closed_segment t0 t› this]
show False using ss ‹s ≠ t0›
by (auto simp: dist_real_def open_segment_eq_real_ivl split_ifs)
qed
have "norm (f ss (y ss)) ≤ B"
apply (rule norm_f)
subgoal using ss st closed_segment_subset_domain[OF initial_time_in ‹t ∈ T›] by auto
subgoal using ss st b_less less_b
by (intro y_bounded)
(auto simp: X_def dist_norm b_def init norm_minus_commute mem_cball)
done
} note bnd = this
have subs: "open_segment t0 s ⊆ open_segment t0 t" using s_bound ‹s ≠ t0›
by (auto simp: closed_segment_eq_real_ivl open_segment_eq_real_ivl)
with differentiable_bound_general_open_segment[OF cont bnd_cont has_vderiv_on_subset[OF solves subs]
bnd_deriv bnd]
have "norm (x s - x t0) ≤ B * ¦s - t0¦"
by (auto simp: algebra_simps[symmetric] abs_mult B_nonneg)
also
have "s ≠ t"
using s_bound exceeds min not_max
by (auto simp: dist_norm closed_segment_eq_real_ivl split_ifs)
hence "B * ¦s - t0¦ < ¦t - t0¦ * B"
using s_bound ‹B > 0›
by (intro le_neq_trans)
(auto simp: algebra_simps closed_segment_eq_real_ivl split_ifs
intro!: mult_left_mono)
finally have "norm (x s - x t0) < ¦t - t0¦ * B" .
moreover
{
have "b ≥ ¦t - t0¦ * B" by (simp add: b_def algebra_simps)
also from exceeds have "norm (x s - x t0) ≥ b" by simp
finally have "¦t - t0¦ * B ≤ norm (x s - x t0)" .
}
ultimately show False by simp
qed note mvt_result = this
from cont assms
have cont_diff: "continuous_on (closed_segment t0 t) (λxa. x xa - x t0)"
by (auto intro!: continuous_intros)
have "norm (x t - x t0) ≤ b"
proof (rule ccontr)
assume H: "¬ norm (x t - x t0) ≤ b"
hence "b ∈ closed_segment (norm (x t0 - x t0)) (norm (x t - x t0))"
using assms T_def ‹0 < b›
by (auto simp: closed_segment_eq_real_ivl )
from IVT'_closed_segment_real[OF this continuous_on_norm[OF cont_diff]]
obtain s where s: "s ∈ closed_segment t0 t" "norm (x s - x t0) = b"
using ‹b > 0› by auto
have "s ∈ {s ∈ closed_segment t0 t. norm (x s - x t0) ∈ {b..}}"
using s ‹t ∈ T› by (auto simp: initial_time_in)
with mvt_result have "s = t" by blast
hence "s = t" using s ‹t ∈ T› by (auto simp: initial_time_in)
with s H show False by simp
qed
hence "x t ∈ cball x0 b" using init
by (auto simp: dist_commute dist_norm[symmetric] mem_cball)
thus "x t ∈ cball x0 (B * abs (t - t0))" unfolding cylinder b_def .
qed (simp add: init[symmetric])
qed
lemma in_bounds_derivative_globalI:
assumes "t ∈ T"
assumes init: "x t0 = x0"
assumes cont: "continuous_on (closed_segment t0 t) x"
assumes solves: "(x has_vderiv_on (λs. f s (y s))) (open_segment t0 t)"
assumes y_bounded: "⋀ξ. ξ ∈ closed_segment t0 t ⟹ x ξ ∈ X ⟹ y ξ ∈ X"
shows "x t ∈ X"
proof -
from in_bounds_derivativeI[OF assms]
have "x t ∈ cball x0 (B * abs (t - t0))" .
moreover have "B * abs (t - t0) ≤ b" using e_bounded b_pos B_nonneg ‹t ∈ T›
by (cases "B = 0")
(auto simp: field_simps initial_time_in dist_real_def abs_real_def closed_segment_eq_real_ivl split: if_splits)
ultimately show ?thesis by (auto simp: cylinder mem_cball)
qed
lemma integral_in_bounds:
assumes "t ∈ T" "x t0 = x0" "x ∈ {t0 -- t} → X"
assumes cont[continuous_intros]: "continuous_on ({t0 -- t}) x"
shows "x t0 + ivl_integral t0 t (λt. f t (x t)) ∈ X" (is "_ + ?ix t ∈ X")
proof cases
assume "t = t0"
thus ?thesis by (auto simp: cylinder b_pos assms)
next
assume "t ≠ t0"
from closed_segment_subset_domain[OF initial_time_in]
have cont_f:"continuous_on {t0 -- t} (λt. f t (x t))"
using assms
by (intro continuous_intros)
(auto intro: cont continuous_on_subset[OF continuous] simp: cylinder split: if_splits)
from closed_segment_subset_domain[OF initial_time_in ‹t ∈ T›]
have subsets: "s ∈ {t0--t} ⟹ s ∈ T" "s ∈ open_segment t0 t ⟹ s ∈ {t0--t}" for s
by (auto simp: closed_segment_eq_real_ivl open_segment_eq_real_ivl initial_time_in split: if_split_asm)
show ?thesis
unfolding ‹x t0 = _›
using assms ‹t ≠ t0›
by (intro in_bounds_derivative_globalI[where y=x and x="λt. x0 + ?ix t"])
(auto simp: initial_time_in subsets cylinder has_vderiv_on_def
split: if_split_asm
intro!: cont_f has_vector_derivative_const integrable_continuous_closed_segment
has_vector_derivative_within_subset[OF ivl_integral_has_vector_derivative]
has_vector_derivative_add[THEN has_vector_derivative_eq_rhs]
continuous_intros indefinite_ivl_integral_continuous)
qed
lemma solves_in_cone:
assumes "t ∈ T"
assumes init: "x t0 = x0"
assumes cont: "continuous_on (closed_segment t0 t) x"
assumes solves: "(x has_vderiv_on (λs. f s (x s))) (open_segment t0 t)"
shows "x t ∈ cball x0 (B * abs (t - t0))"
using assms
by (rule in_bounds_derivativeI)
lemma is_solution_in_cone:
assumes "t ∈ T"
assumes sol: "(x solves_ode f) (closed_segment t0 t) Y" and iv: "x t0 = x0"
shows "x t ∈ cball x0 (B * abs (t - t0))"
using solves_odeD[OF sol] ‹t ∈ T›
by (intro solves_in_cone)
(auto intro!: assms vderiv_on_continuous_on segment_open_subset_closed
intro: has_vderiv_on_subset simp: initial_time_in)
lemma cone_subset_domain:
assumes "t ∈ T"
shows "cball x0 (B * ¦t - t0¦) ⊆ X"
using e_bounded[OF assms] B_nonneg b_pos
unfolding cylinder
by (intro subset_cball) (auto simp: dist_real_def divide_simps algebra_simps split: if_splits)
lemma is_solution_in_domain:
assumes "t ∈ T"
assumes sol: "(x solves_ode f) (closed_segment t0 t) Y" and iv: "x t0 = x0"
shows "x t ∈ X"
using is_solution_in_cone[OF assms] cone_subset_domain[OF ‹t ∈ T›]
by (rule rev_subsetD)
lemma solves_ode_on_subset_domain:
assumes sol: "(x solves_ode f) S Y" and iv: "x t0 = x0"
and ivl: "t0 ∈ S" "is_interval S" "S ⊆ T"
shows "(x solves_ode f) S X"
proof (rule solves_odeI)
show "(x has_vderiv_on (λt. f t (x t))) S" using solves_odeD(1)[OF sol] .
show "x s ∈ X" if s: "s ∈ S" for s
proof -
from s assms have "s ∈ T"
by auto
moreover
have "{t0--s} ⊆ S"
by (rule closed_segment_subset) (auto simp: s assms is_interval_convex)
with sol have "(x solves_ode f) {t0--s} Y"
using order_refl
by (rule solves_ode_on_subset)
ultimately
show ?thesis using iv
by (rule is_solution_in_domain)
qed
qed
lemma usolves_ode_on_subset:
assumes x: "(x usolves_ode f from t0) T X" and iv: "x t0 = x0"
assumes "t0 ∈ S" "is_interval S" "S ⊆ T" "X ⊆ Y"
shows "(x usolves_ode f from t0) S Y"
proof (rule usolves_odeI)
show "(x solves_ode f) S Y" by (rule solves_ode_on_subset[OF usolves_odeD(1)[OF x]]; fact)
show "t0 ∈ S" "is_interval S" by fact+
fix z t assume "{t0 -- t} ⊆ S" and z: "(z solves_ode f) {t0--t} Y" "z t0 = x t0"
then have "z t0 = x0" "t0 ∈ {t0--t}" "is_interval {t0--t}" "{t0--t} ⊆ T"
using iv ‹S ⊆ T› by (auto simp: is_interval_convex_1)
with z(1) have zX: "(z solves_ode f) {t0 -- t} X"
by (rule solves_ode_on_subset_domain)
show "z t = x t"
apply (rule usolves_odeD(4)[OF x _ _ _ zX])
using ‹{t0 -- t} ⊆ S› ‹S ⊆ T›
by (auto simp: is_interval_convex_1 ‹z t0 = x t0›)
qed
lemma usolves_ode_on_superset_domain:
assumes "(x usolves_ode f from t0) T X" and iv: "x t0 = x0"
assumes "X ⊆ Y"
shows "(x usolves_ode f from t0) T Y"
using assms(1,2) usolves_odeD(2,3)[OF assms(1)] order_refl assms(3)
by (rule usolves_ode_on_subset)
end
locale unique_on_cylinder =
solution_in_cylinder t0 T x0 b f X B +
global_lipschitz T X f L
for t0 T x0 b X f B L
begin
sublocale unique_on_closed t0 T x0 f X L
apply unfold_locales
subgoal by (simp add: initial_time_in)
subgoal by (simp add: X_def b_pos)
subgoal by (auto intro!: integral_in_bounds simp: initial_time_in)
subgoal by (auto intro!: continuous_intros simp: split_beta' X_def)
subgoal by (simp add: X_def)
done
end
locale derivative_on_prod =
fixes T X and f::"real ⇒ 'a::banach ⇒ 'a" and f':: "real × 'a ⇒ (real × 'a) ⇒ 'a"
assumes f': "⋀tx. tx ∈ T × X ⟹ ((λ(t, x). f t x) has_derivative (f' tx)) (at tx within (T × X))"
begin
lemma f'_comp[derivative_intros]:
"(g has_derivative g') (at s within S) ⟹ (h has_derivative h') (at s within S) ⟹
s ∈ S ⟹ (⋀x. x ∈ S ⟹ g x ∈ T) ⟹ (⋀x. x ∈ S ⟹ h x ∈ X) ⟹
((λx. f (g x) (h x)) has_derivative (λy. f' (g s, h s) (g' y, h' y))) (at s within S)"
apply (rule has_derivative_in_compose2[OF f' _ _ has_derivative_Pair, unfolded split_beta' fst_conv snd_conv, of g h S s g' h'])
apply auto
done
lemma derivative_on_prod_subset:
assumes "X' ⊆ X"
shows "derivative_on_prod T X' f f'"
using assms
by (unfold_locales) (auto intro!: derivative_eq_intros)
end
end
Theory Picard_Lindeloef_Qualitative
theory Picard_Lindeloef_Qualitative
imports Initial_Value_Problem
begin
subsection ‹Picard-Lindeloef On Open Domains›
text‹\label{sec:qpl}›
subsubsection ‹Local Solution with local Lipschitz›
text‹\label{sec:qpl-lipschitz}›
lemma cball_eq_closed_segment_real:
fixes x e::real
shows "cball x e = (if e ≥ 0 then {x - e -- x + e} else {})"
by (auto simp: closed_segment_eq_real_ivl dist_real_def mem_cball)
lemma cube_in_cball:
fixes x y :: "'a::euclidean_space"
assumes "r > 0"
assumes "⋀i. i∈ Basis ⟹ dist (x ∙ i) (y ∙ i) ≤ r / sqrt(DIM('a))"
shows "y ∈ cball x r"
unfolding mem_cball euclidean_dist_l2[of x y] L2_set_def
proof -
have "(∑i∈Basis. (dist (x ∙ i) (y ∙ i))⇧2) ≤ (∑(i::'a)∈Basis. (r / sqrt(DIM('a)))⇧2)"
proof (intro sum_mono)
fix i :: 'a
assume "i ∈ Basis"
thus "(dist (x ∙ i) (y ∙ i))⇧2 ≤ (r / sqrt(DIM('a)))⇧2"
using assms
by (auto intro: sqrt_le_D)
qed
moreover
have "... ≤ r⇧2"
using assms by (simp add: power_divide)
ultimately
show "sqrt (∑i∈Basis. (dist (x ∙ i) (y ∙ i))⇧2) ≤ r"
using assms by (auto intro!: real_le_lsqrt sum_nonneg)
qed
lemma cbox_in_cball':
fixes x::"'a::euclidean_space"
assumes "0 < r"
shows "∃b > 0. b ≤ r ∧ (∃B. B = (∑i∈Basis. b *⇩R i) ∧ (∀y ∈ cbox (x - B) (x + B). y ∈ cball x r))"
proof (rule, safe)
have "r / sqrt (real DIM('a)) ≤ r / 1"
using assms by (auto simp: divide_simps real_of_nat_ge_one_iff)
thus "r / sqrt (real DIM('a)) ≤ r" by simp
next
let ?B = "∑i∈Basis. (r / sqrt (real DIM('a))) *⇩R i"
show "∃B. B = ?B ∧ (∀y ∈ cbox (x - B) (x + B). y ∈ cball x r)"
proof (rule, safe)
fix y::'a
assume "y ∈ cbox (x - ?B) (x + ?B)"
hence bounds:
"⋀i. i ∈ Basis ⟹ (x - ?B) ∙ i ≤ y ∙ i"
"⋀i. i ∈ Basis ⟹ y ∙ i ≤ (x + ?B) ∙ i"
by (auto simp: mem_box)
show "y ∈ cball x r"
proof (intro cube_in_cball)
fix i :: 'a
assume "i∈ Basis"
with bounds
have bounds_comp:
"x ∙ i - r / sqrt (real DIM('a)) ≤ y ∙ i"
"y ∙ i ≤ x ∙ i + r / sqrt (real DIM('a))"
by (auto simp: algebra_simps)
thus "dist (x ∙ i) (y ∙ i) ≤ r / sqrt (real DIM('a))"
unfolding dist_real_def by simp
qed (auto simp add: assms)
qed (rule)
qed (auto simp: assms)
lemma Pair1_in_Basis: "i ∈ Basis ⟹ (i, 0) ∈ Basis"
and Pair2_in_Basis: "i ∈ Basis ⟹ (0, i) ∈ Basis"
by (auto simp: Basis_prod_def)
lemma le_real_sqrt_sumsq' [simp]: "y ≤ sqrt (x * x + y * y)"
by (simp add: power2_eq_square [symmetric])
lemma cball_Pair_split_subset: "cball (a, b) c ⊆ cball a c × cball b c"
by (auto simp: dist_prod_def mem_cball power2_eq_square
intro: order_trans[OF le_real_sqrt_sumsq] order_trans[OF le_real_sqrt_sumsq'])
lemma cball_times_subset: "cball a (c/2) × cball b (c/2) ⊆ cball (a, b) c"
proof -
{
fix a' b'
have "sqrt ((dist a a')⇧2 + (dist b b')⇧2) ≤ dist a a' + dist b b'"
by (rule real_le_lsqrt) (auto simp: power2_eq_square algebra_simps)
also assume "a' ∈ cball a (c / 2)"
then have "dist a a' ≤ c / 2" by (simp add: mem_cball)
also assume "b' ∈ cball b (c / 2)"
then have "dist b b' ≤ c / 2" by (simp add: mem_cball)
finally have "sqrt ((dist a a')⇧2 + (dist b b')⇧2) ≤ c"
by simp
} thus ?thesis by (auto simp: dist_prod_def mem_cball)
qed
lemma eventually_bound_pairE:
assumes "isCont f (t0, x0)"
obtains B where
"B ≥ 1"
"eventually (λe. ∀x ∈ cball t0 e × cball x0 e. norm (f x) ≤ B) (at_right 0)"
proof -
from assms[simplified isCont_def, THEN tendstoD, OF zero_less_one]
obtain d::real where d: "d > 0"
"⋀x. x ≠ (t0, x0) ⟹ dist x (t0, x0) < d ⟹ dist (f x) (f (t0, x0)) < 1"
by (auto simp: eventually_at)
have bound: "norm (f (t, x)) ≤ norm (f (t0, x0)) + 1"
if "t ∈ cball t0 (d/3)" "x ∈ cball x0 (d/3)" for t x
proof -
from that have "norm (f (t, x) - f (t0, x0)) < 1"
using ‹0 < d›
unfolding dist_norm[symmetric]
apply (cases "(t, x) = (t0, x0)", force)
by (rule d) (auto simp: dist_commute dist_prod_def mem_cball
intro!: le_less_trans[OF sqrt_sum_squares_le_sum_abs])
then show ?thesis
by norm
qed
have "norm (f (t0, x0)) + 1 ≥ 1"
"eventually (λe. ∀x ∈ cball t0 e × cball x0 e.
norm (f x) ≤ norm (f (t0, x0)) + 1) (at_right 0)"
using d(1) bound
by (auto simp: eventually_at dist_real_def mem_cball intro!: exI[where x="d/3"])
thus ?thesis ..
qed
lemma
eventually_in_cballs:
assumes "d > 0" "c > 0"
shows "eventually (λe. cball t0 (c * e) × (cball x0 e) ⊆ cball (t0, x0) d) (at_right 0)"
using assms
by (auto simp: eventually_at dist_real_def field_simps dist_prod_def mem_cball
intro!: exI[where x="min d (d / c) / 3"]
order_trans[OF sqrt_sum_squares_le_sum_abs])
lemma cball_eq_sing':
fixes x :: "'a::{metric_space,perfect_space}"
shows "cball x e = {y} ⟷ e = 0 ∧ x = y"
using cball_eq_sing[of x e]
apply (cases "x = y", force)
by (metis cball_empty centre_in_cball insert_not_empty not_le singletonD)
locale ll_on_open = interval T for T +
fixes f::"real ⇒ 'a::{banach, heine_borel} ⇒ 'a" and X
assumes local_lipschitz: "local_lipschitz T X f"
assumes cont: "⋀x. x ∈ X ⟹ continuous_on T (λt. f t x)"
assumes open_domain[intro!, simp]: "open T" "open X"
begin
text ‹all flows on closed segments›
definition csols where
"csols t0 x0 = {(x, t1). {t0--t1} ⊆ T ∧ x t0 = x0 ∧ (x solves_ode f) {t0--t1} X}"
text ‹the maximal existence interval›
definition "existence_ivl t0 x0 = (⋃(x, t1)∈csols t0 x0 . {t0--t1})"
text ‹witness flow›
definition "csol t0 x0 = (SOME csol. ∀t ∈ existence_ivl t0 x0. (csol t, t) ∈ csols t0 x0)"
text ‹unique flow›
definition flow where "flow t0 x0 = (λt. if t ∈ existence_ivl t0 x0 then csol t0 x0 t t else 0)"
end
locale ll_on_open_it =
general?:
ll_on_open + fixes t0::real
context ll_on_open begin
sublocale ll_on_open_it where t0 = t0 for t0 ..
sublocale continuous_rhs T X f
by unfold_locales (rule continuous_on_TimesI[OF local_lipschitz cont])
end
context ll_on_open_it begin
lemma ll_on_open_rev[intro, simp]: "ll_on_open (preflect t0 ` T) (λt. - f (preflect t0 t)) X"
using local_lipschitz interval
by unfold_locales
(auto intro!: continuous_intros cont intro: local_lipschitz_compose1
simp: fun_Compl_def local_lipschitz_minus local_lipschitz_subset open_neg_translation
image_image preflect_def)
lemma eventually_lipschitz:
assumes "t0 ∈ T" "x0 ∈ X" "c > 0"
obtains L where
"eventually (λu. ∀t' ∈ cball t0 (c * u) ∩ T.
L-lipschitz_on (cball x0 u ∩ X) (λy. f t' y)) (at_right 0)"
proof -
from local_lipschitzE[OF local_lipschitz, OF ‹t0 ∈ T› ‹x0 ∈ X›]
obtain u L where
"u > 0"
"⋀t'. t' ∈ cball t0 u ∩ T ⟹ L-lipschitz_on (cball x0 u ∩ X) (λy. f t' y)"
by auto
hence "eventually (λu. ∀t' ∈ cball t0 (c * u) ∩ T.
L-lipschitz_on (cball x0 u ∩ X) (λy. f t' y)) (at_right 0)"
using ‹u > 0› ‹c > 0›
by (auto simp: dist_real_def eventually_at divide_simps algebra_simps
intro!: exI[where x="min u (u / c)"]
intro: lipschitz_on_subset[where E="cball x0 u ∩ X"])
thus ?thesis ..
qed
lemmas continuous_on_Times_f = continuous
lemmas continuous_on_f = continuous_rhs_comp
lemma
lipschitz_on_compact:
assumes "compact K" "K ⊆ T"
assumes "compact Y" "Y ⊆ X"
obtains L where "⋀t. t ∈ K ⟹ L-lipschitz_on Y (f t)"
proof -
have cont: "⋀x. x ∈ Y ⟹ continuous_on K (λt. f t x)"
using ‹Y ⊆ X› ‹K ⊆ T›
by (auto intro!: continuous_on_f continuous_intros)
from local_lipschitz
have "local_lipschitz K Y f"
by (rule local_lipschitz_subset[OF _ ‹K ⊆ T› ‹Y ⊆ X›])
from local_lipschitz_compact_implies_lipschitz[OF this ‹compact Y› ‹compact K› cont] that
show ?thesis by metis
qed
lemma csols_empty_iff: "csols t0 x0 = {} ⟷ t0 ∉ T ∨ x0 ∉ X"
proof cases
assume iv_defined: "t0 ∈ T ∧ x0 ∈ X"
then have "(λ_. x0, t0) ∈ csols t0 x0"
by (auto simp: csols_def intro!: solves_ode_singleton)
then show ?thesis using ‹t0 ∈ T ∧ x0 ∈ X› by auto
qed (auto simp: solves_ode_domainD csols_def)
lemma csols_notempty: "t0 ∈ T ⟹ x0 ∈ X ⟹ csols t0 x0 ≠ {}"
by (simp add: csols_empty_iff)
lemma existence_ivl_empty_iff[simp]: "existence_ivl t0 x0 = {} ⟷ t0 ∉ T ∨ x0 ∉ X"
using csols_empty_iff
by (auto simp: existence_ivl_def)
lemma existence_ivl_empty1[simp]: "t0 ∉ T ⟹ existence_ivl t0 x0 = {}"
and existence_ivl_empty2[simp]: "x0 ∉ X ⟹ existence_ivl t0 x0 = {}"
using csols_empty_iff
by (auto simp: existence_ivl_def)
lemma flow_undefined:
shows "t0 ∉ T ⟹ flow t0 x0 = (λ_. 0)"
"x0 ∉ X ⟹ flow t0 x0 = (λ_. 0)"
using existence_ivl_empty_iff
by (auto simp: flow_def)
lemma (in ll_on_open) flow_eq_in_existence_ivlI:
assumes "⋀u. x0 ∈ X ⟹ u ∈ existence_ivl t0 x0 ⟷ g u ∈ existence_ivl s0 x0"
assumes "⋀u. x0 ∈ X ⟹ u ∈ existence_ivl t0 x0 ⟹ flow t0 x0 u = flow s0 x0 (g u)"
shows "flow t0 x0 = (λt. flow s0 x0 (g t))"
apply (cases "x0 ∈ X")
subgoal using assms by (auto intro!: ext simp: flow_def)
subgoal by (simp add: flow_undefined)
done
subsubsection ‹Global maximal flow with local Lipschitz›
text‹\label{sec:qpl-global-flow}›
lemma local_unique_solution:
assumes iv_defined: "t0 ∈ T" "x0 ∈ X"
obtains et ex B L
where "et > 0" "0 < ex" "cball t0 et ⊆ T" "cball x0 ex ⊆ X"
"unique_on_cylinder t0 (cball t0 et) x0 ex f B L"
proof -
have "∀⇩F e::real in at_right 0. 0 < e"
by (auto simp: eventually_at_filter)
moreover
from open_Times[OF open_domain] have "open (T × X)" .
from at_within_open[OF _ this] iv_defined
have "isCont (λ(t, x). f t x) (t0, x0)"
using continuous by (auto simp: continuous_on_eq_continuous_within)
from eventually_bound_pairE[OF this]
obtain B where B:
"1 ≤ B" "∀⇩F e in at_right 0. ∀t∈cball t0 e. ∀x∈cball x0 e. norm (f t x) ≤ B"
by (force simp: )
note B(2)
moreover
define t where "t ≡ inverse B"
have te: "⋀e. e > 0 ⟹ t * e > 0"
using ‹1 ≤ B› by (auto simp: t_def field_simps)
have t_pos: "t > 0"
using ‹1 ≤ B› by (auto simp: t_def)
from B(2) obtain dB where "0 < dB" "0 < dB / 2"
and dB: "⋀d t x. 0 < d ⟹ d < dB ⟹ t∈cball t0 d ⟹ x∈cball x0 d ⟹
norm (f t x) ≤ B"
by (auto simp: eventually_at dist_real_def Ball_def)
hence dB': "⋀t x. (t, x) ∈ cball (t0, x0) (dB / 2) ⟹ norm (f t x) ≤ B"
using cball_Pair_split_subset[of t0 x0 "dB / 2"]
by (auto simp: eventually_at dist_real_def
simp del: mem_cball
intro!: dB[where d="dB/2"])
from eventually_in_cballs[OF ‹0 < dB/2› t_pos, of t0 x0]
have "∀⇩F e in at_right 0. ∀t∈cball t0 (t * e). ∀x∈cball x0 e. norm (f t x) ≤ B"
unfolding eventually_at_filter
by eventually_elim (auto intro!: dB')
moreover
from eventually_lipschitz[OF iv_defined t_pos] obtain L where
"∀⇩F u in at_right 0. ∀t'∈cball t0 (t * u) ∩ T. L-lipschitz_on (cball x0 u ∩ X) (f t')"
by auto
moreover
have "∀⇩F e in at_right 0. cball t0 (t * e) ⊆ T"
using eventually_open_cball[OF open_domain(1) iv_defined(1)]
by (subst eventually_filtermap[symmetric, where f="λx. t * x"])
(simp add: filtermap_times_pos_at_right t_pos)
moreover
have "eventually (λe. cball x0 e ⊆ X) (at_right 0)"
using open_domain(2) iv_defined(2)
by (rule eventually_open_cball)
ultimately have "∀⇩F e in at_right 0. 0 < e ∧ cball t0 (t * e) ⊆ T ∧ cball x0 e ⊆ X ∧
unique_on_cylinder t0 (cball t0 (t * e)) x0 e f B L"
proof eventually_elim
case (elim e)
note ‹0 < e›
moreover
note T = ‹cball t0 (t * e) ⊆ T›
moreover
note X = ‹cball x0 e ⊆ X›
moreover
from elim Int_absorb2[OF ‹cball x0 e ⊆ X›]
have L: "t' ∈ cball t0 (t * e) ∩ T ⟹ L-lipschitz_on (cball x0 e) (f t')" for t'
by auto
from elim have B: "⋀t' x. t' ∈ cball t0 (t * e) ⟹ x ∈ cball x0 e ⟹ norm (f t' x) ≤ B"
by auto
have "t * e ≤ e / B"
by (auto simp: t_def cball_def dist_real_def inverse_eq_divide)
have "{t0 -- t0 + t * e} ⊆ cball t0 (t * e)"
using ‹t > 0› ‹e > 0›
by (auto simp: cball_eq_closed_segment_real closed_segment_eq_real_ivl)
then have "unique_on_cylinder t0 (cball t0 (t * e)) x0 e f B L"
using T X ‹t > 0› ‹e > 0› ‹t * e ≤ e / B›
by unfold_locales
(auto intro!: continuous_rhs_comp continuous_on_fst continuous_on_snd B L
continuous_on_id
simp: split_beta' dist_commute mem_cball)
ultimately show ?case by auto
qed
from eventually_happens[OF this]
obtain e where "0 < e" "cball t0 (t * e) ⊆ T" "cball x0 e ⊆ X"
"unique_on_cylinder t0 (cball t0 (t * e)) x0 e f B L"
by (metis trivial_limit_at_right_real)
with mult_pos_pos[OF ‹0 < t› ‹0 < e›] show ?thesis ..
qed
lemma mem_existence_ivl_iv_defined:
assumes "t ∈ existence_ivl t0 x0"
shows "t0 ∈ T" "x0 ∈ X"
using assms existence_ivl_empty_iff
unfolding atomize_conj
by blast
lemma csol_mem_csols:
assumes "t ∈ existence_ivl t0 x0"
shows "(csol t0 x0 t, t) ∈ csols t0 x0"
proof -
have "∃csol. ∀t ∈ existence_ivl t0 x0. (csol t, t) ∈ csols t0 x0"
proof (safe intro!: bchoice)
fix t assume "t ∈ existence_ivl t0 x0"
then obtain csol t1 where csol: "(csol t, t1) ∈ csols t0 x0" "t ∈ {t0 -- t1}"
by (auto simp: existence_ivl_def)
then have "{t0--t} ⊆ {t0 -- t1}"
by (auto simp: closed_segment_eq_real_ivl)
then have "(csol t, t) ∈ csols t0 x0" using csol
by (auto simp: csols_def intro: solves_ode_on_subset)
then show "∃y. (y, t) ∈ csols t0 x0" by force
qed
then have "∀t ∈ existence_ivl t0 x0. (csol t0 x0 t, t) ∈ csols t0 x0"
unfolding csol_def
by (rule someI_ex)
with assms show "?thesis" by auto
qed
lemma csol:
assumes "t ∈ existence_ivl t0 x0"
shows "t ∈ T" "{t0--t} ⊆ T" "csol t0 x0 t t0 = x0" "(csol t0 x0 t solves_ode f) {t0--t} X"
using csol_mem_csols[OF assms]
by (auto simp: csols_def)
lemma existence_ivl_initial_time_iff[simp]: "t0 ∈ existence_ivl t0 x0 ⟷ t0 ∈ T ∧ x0 ∈ X"
using csols_empty_iff
by (auto simp: existence_ivl_def)
lemma existence_ivl_initial_time: "t0 ∈ T ⟹ x0 ∈ X ⟹ t0 ∈ existence_ivl t0 x0"
by simp
lemmas mem_existence_ivl_subset = csol(1)
lemma existence_ivl_subset:
"existence_ivl t0 x0 ⊆ T"
using mem_existence_ivl_subset by blast
lemma is_interval_existence_ivl[intro, simp]: "is_interval (existence_ivl t0 x0)"
unfolding is_interval_connected_1
by (auto simp: existence_ivl_def intro!: connected_Union)
lemma connected_existence_ivl[intro, simp]: "connected (existence_ivl t0 x0)"
using is_interval_connected by blast
lemma in_existence_between_zeroI:
"t ∈ existence_ivl t0 x0 ⟹ s ∈ {t0 -- t} ⟹ s ∈ existence_ivl t0 x0"
by (meson existence_ivl_initial_time interval.closed_segment_subset_domainI interval.intro
is_interval_existence_ivl mem_existence_ivl_iv_defined(1) mem_existence_ivl_iv_defined(2))
lemma segment_subset_existence_ivl:
assumes "s ∈ existence_ivl t0 x0" "t ∈ existence_ivl t0 x0"
shows "{s -- t} ⊆ existence_ivl t0 x0"
using assms is_interval_existence_ivl
unfolding is_interval_convex_1
by (rule closed_segment_subset)
lemma flow_initial_time_if: "flow t0 x0 t0 = (if t0 ∈ T ∧ x0 ∈ X then x0 else 0)"
by (simp add: flow_def csol(3))
lemma flow_initial_time[simp]: "t0 ∈ T ⟹ x0 ∈ X ⟹ flow t0 x0 t0 = x0"
by (auto simp: flow_initial_time_if)
lemma open_existence_ivl[intro, simp]: "open (existence_ivl t0 x0)"
proof (rule openI)
fix t assume t: "t ∈ existence_ivl t0 x0"
note csol = csol[OF this]
note mem_existence_ivl_iv_defined[OF t]
have "flow t0 x0 t ∈ X" using ‹t ∈ existence_ivl t0 x0›
using csol(4) solves_ode_domainD
by (force simp add: flow_def)
from ll_on_open_it.local_unique_solution[OF ll_on_open_it_axioms ‹t ∈ T› this]
obtain et ex B L where lsol:
"0 < et"
"0 < ex"
"cball t et ⊆ T"
"cball (flow t0 x0 t) ex ⊆ X"
"unique_on_cylinder t (cball t et) (flow t0 x0 t) ex f B L"
by metis
then interpret unique_on_cylinder t "cball t et" "flow t0 x0 t" ex "cball (flow t0 x0 t) ex" f B L
by auto
from solution_usolves_ode have lsol_ode: "(solution solves_ode f) (cball t et) (cball (flow t0 x0 t) ex)"
by (intro usolves_odeD)
show "∃e>0. ball t e ⊆ existence_ivl t0 x0"
proof cases
assume "t = t0"
show ?thesis
proof (safe intro!: exI[where x="et"] mult_pos_pos ‹0 < et› ‹0 < ex›)
fix t' assume "t' ∈ ball t et"
then have subset: "{t0--t'} ⊆ ball t et"
by (intro closed_segment_subset) (auto simp: ‹0 < et› ‹0 < ex› ‹t = t0›)
also have "… ⊆ cball t et" by simp
also note ‹cball t _ ⊆ T›
finally have "{t0--t'} ⊆ T" by simp
moreover have "(solution solves_ode f) {t0--t'} X"
using lsol_ode
apply (rule solves_ode_on_subset)
using subset lsol
by (auto simp: mem_ball mem_cball)
ultimately have "(solution, t') ∈ csols t0 x0"
unfolding csols_def
using lsol ‹t' ∈ ball _ _› lsol ‹t = t0› solution_iv ‹x0 ∈ X›
by (auto simp: csols_def)
then show "t' ∈ existence_ivl t0 x0"
unfolding existence_ivl_def
by force
qed
next
assume "t ≠ t0"
let ?m = "min et (dist t0 t / 2)"
show ?thesis
proof (safe intro!: exI[where x = ?m])
let ?t1' = "if t0 ≤ t then t + et else t - et"
have lsol_ode: "(solution solves_ode f) {t -- ?t1'} (cball (flow t0 x0 t) ex)"
by (rule solves_ode_on_subset[OF lsol_ode])
(insert ‹0 < et› ‹0 < ex›, auto simp: mem_cball closed_segment_eq_real_ivl dist_real_def)
let ?if = "λta. if ta ∈ {t0--t} then csol t0 x0 t ta else solution ta"
let ?iff = "λta. if ta ∈ {t0--t} then f ta else f ta"
have "(?if solves_ode ?iff) ({t0--t} ∪ {t -- ?t1'}) X"
apply (rule connection_solves_ode[OF csol(4) lsol_ode, unfolded Un_absorb2[OF ‹_ ⊆ X›]])
using lsol solution_iv ‹t ∈ existence_ivl t0 x0›
by (auto intro!: simp: closed_segment_eq_real_ivl flow_def split: if_split_asm)
also have "?iff = f" by auto
also have Un_eq: "{t0--t} ∪ {t -- ?t1'} = {t0 -- ?t1'}"
using ‹0 < et› ‹0 < ex›
by (auto simp: closed_segment_eq_real_ivl)
finally have continuation: "(?if solves_ode f) {t0--?t1'} X" .
have subset_T: "{t0 -- ?t1'} ⊆ T"
unfolding Un_eq[symmetric]
apply (intro Un_least)
subgoal using csol by force
subgoal using _ lsol(3)
apply (rule order_trans)
using ‹0 < et› ‹0 < ex›
by (auto simp: closed_segment_eq_real_ivl subset_iff mem_cball dist_real_def)
done
fix t' assume "t' ∈ ball t ?m"
then have scs: "{t0 -- t'} ⊆ {t0--?t1'}"
using ‹0 < et› ‹0 < ex›
by (auto simp: closed_segment_eq_real_ivl dist_real_def abs_real_def mem_ball split: if_split_asm)
with continuation have "(?if solves_ode f) {t0 -- t'} X"
by (rule solves_ode_on_subset) simp
then have "(?if, t') ∈ csols t0 x0"
using lsol ‹t' ∈ ball _ _› csol scs subset_T
by (auto simp: csols_def subset_iff)
then show "t' ∈ existence_ivl t0 x0"
unfolding existence_ivl_def
by force
qed (insert ‹t ≠ t0› ‹0 < et› ‹0 < ex›, simp)
qed
qed
lemma csols_unique:
assumes "(x, t1) ∈ csols t0 x0"
assumes "(y, t2) ∈ csols t0 x0"
shows "∀t ∈ {t0 -- t1} ∩ {t0 -- t2}. x t = y t"
proof (rule ccontr)
let ?S = "{t0 -- t1} ∩ {t0 -- t2}"
let ?Z0 = "(λt. x t - y t) -` {0} ∩ ?S"
let ?Z = "connected_component_set ?Z0 t0"
from assms have t1: "t1 ∈ existence_ivl t0 x0" and t2: "t2 ∈ existence_ivl t0 x0"
and x: "(x solves_ode f) {t0 -- t1} X"
and y: "(y solves_ode f) {t0 -- t2} X"
and sub1: "{t0--t1} ⊆ T"
and sub2: "{t0--t2} ⊆ T"
and x0: "x t0 = x0"
and y0: "y t0 = x0"
by (auto simp: existence_ivl_def csols_def)
assume "¬ (∀t∈?S. x t = y t)"
hence "∃t∈?S. x t ≠ y t" by simp
then obtain t_ne where t_ne: "t_ne ∈ ?S" "x t_ne ≠ y t_ne" ..
from assms have x: "(x solves_ode f) {t0--t1} X"
and y:"(y solves_ode f) {t0--t2} X"
by (auto simp: csols_def)
have "compact ?S"
by auto
have "closed ?Z"
by (intro closed_connected_component closed_vimage_Int)
(auto intro!: continuous_intros continuous_on_subset[OF solves_ode_continuous_on[OF x]]
continuous_on_subset[OF solves_ode_continuous_on[OF y]])
moreover
have "t0 ∈ ?Z" using assms
by (auto simp: csols_def)
then have "?Z ≠ {}"
by (auto intro!: exI[where x=t0])
ultimately
obtain t_max where max: "t_max ∈ ?Z" "y ∈ ?Z ⟹ dist t_ne t_max ≤ dist t_ne y" for y
by (blast intro: distance_attains_inf)
have max_equal_flows: "x t = y t" if "t ∈ {t0 -- t_max}" for t
using max(1) that
by (auto simp: connected_component_def vimage_def subset_iff closed_segment_eq_real_ivl
split: if_split_asm) (metis connected_iff_interval)+
then have t_ne_outside: "t_ne ∉ {t0 -- t_max}" using t_ne by auto
have "x t_max = y t_max"
by (rule max_equal_flows) simp
have "t_max ∈ ?S" "t_max ∈ T"
using max sub1 sub2
by (auto simp: connected_component_def)
with solves_odeD[OF x]
have "x t_max ∈ X"
by auto
from ll_on_open_it.local_unique_solution[OF ll_on_open_it_axioms ‹t_max ∈ T› ‹x t_max ∈ X›]
obtain et ex B L
where "0 < et" "0 < ex"
and "cball t_max et ⊆ T" "cball (x t_max) ex ⊆ X"
and "unique_on_cylinder t_max (cball t_max et) (x t_max) ex f B L"
by metis
then interpret unique_on_cylinder t_max "cball t_max et" "x t_max" ex "cball (x t_max) ex" f B L
by auto
from usolves_ode_on_superset_domain[OF solution_usolves_ode solution_iv ‹cball _ _ ⊆ X›]
have solution_usolves_on_X: "(solution usolves_ode f from t_max) (cball t_max et) X" by simp
have ge_imps: "t0 ≤ t1" "t0 ≤ t2" "t0 ≤ t_max" "t_max < t_ne" if "t0 ≤ t_ne"
using that t_ne_outside ‹0 < et› ‹0 < ex› max(1) ‹t_max ∈ ?S› ‹t_max ∈ T› t_ne x0 y0
by (auto simp: min_def dist_real_def max_def closed_segment_eq_real_ivl split: if_split_asm)
have le_imps: "t0 ≥ t1" "t0 ≥ t2" "t0 ≥ t_max" "t_max > t_ne" if "t0 ≥ t_ne"
using that t_ne_outside ‹0 < et› ‹0 < ex› max(1) ‹t_max ∈ ?S› ‹t_max ∈ T› t_ne x0 y0
by (auto simp: min_def dist_real_def max_def closed_segment_eq_real_ivl split: if_split_asm)
define tt where "tt ≡ if t0 ≤ t_ne then min (t_max + et) t_ne else max (t_max - et) t_ne"
have "tt ∈ cball t_max et" "tt ∈ {t0 -- t1}" "tt ∈ {t0 -- t2}"
using ge_imps le_imps ‹0 < et› t_ne(1)
by (auto simp: mem_cball closed_segment_eq_real_ivl tt_def dist_real_def abs_real_def min_def max_def not_less)
have segment_unsplit: "{t0 -- t_max} ∪ {t_max -- tt} = {t0 -- tt}"
using ge_imps le_imps ‹0 < et›
by (auto simp: tt_def closed_segment_eq_real_ivl min_def max_def split: if_split_asm) arith
have "tt ∈ {t0 -- t1}"
using ge_imps le_imps ‹0 < et› t_ne(1)
by (auto simp: tt_def closed_segment_eq_real_ivl min_def max_def split: if_split_asm)
have "tt ∈ ?Z"
proof (safe intro!: connected_componentI[where T = "{t0 -- t_max} ∪ {t_max -- tt}"])
fix s assume s: "s ∈ {t_max -- tt}"
have "{t_max--s} ⊆ {t_max -- tt}"
by (rule closed_segment_subset) (auto simp: s)
also have "… ⊆ cball t_max et"
using ‹tt ∈ cball t_max et› ‹0 < et›
by (intro closed_segment_subset) auto
finally have subset: "{t_max--s} ⊆ cball t_max et" .
from s show "s ∈ {t0--t1}" "s ∈ {t0--t2}"
using ge_imps le_imps t_ne ‹0 < et›
by (auto simp: tt_def min_def max_def closed_segment_eq_real_ivl split: if_split_asm)
have ivl: "t_max ∈ {t_max -- s}" "is_interval {t_max--s}"
using ‹tt ∈ cball t_max et› ‹0 < et› s
by (simp_all add: is_interval_convex_1)
{
note ivl subset
moreover
have "{t_max--s} ⊆ {t0--t1}"
using ‹s ∈ {t0 -- t1}› ‹t_max ∈ ?S›
by (simp add: closed_segment_subset)
from x this order_refl have "(x solves_ode f) {t_max--s} X"
by (rule solves_ode_on_subset)
moreover note solution_iv[symmetric]
ultimately
have "x s = solution s"
by (rule usolves_odeD(4)[OF solution_usolves_on_X]) simp
} moreover {
note ivl subset
moreover
have "{t_max--s} ⊆ {t0--t2}"
using ‹s ∈ {t0 -- t2}› ‹t_max ∈ ?S›
by (simp add: closed_segment_subset)
from y this order_refl have "(y solves_ode f) {t_max--s} X"
by (rule solves_ode_on_subset)
moreover from solution_iv[symmetric] have "y t_max = solution t_max"
by (simp add: ‹x t_max = y t_max›)
ultimately
have "y s = solution s"
by (rule usolves_odeD[OF solution_usolves_on_X]) simp
} ultimately show "s ∈ (λt. x t - y t) -` {0}" by simp
next
fix s assume s: "s ∈ {t0 -- t_max}"
then show "s ∈ (λt. x t - y t) -` {0}"
by (auto intro!: max_equal_flows)
show "s ∈ {t0--t1}" "s ∈ {t0--t2}"
by (metis Int_iff ‹t_max ∈ ?S› closed_segment_closed_segment_subset ends_in_segment(1) s)+
qed (auto simp: segment_unsplit)
then have "dist t_ne t_max ≤ dist t_ne tt"
by (rule max)
moreover have "dist t_ne t_max > dist t_ne tt"
using le_imps ge_imps ‹0 < et›
by (auto simp: tt_def dist_real_def)
ultimately show False by simp
qed
lemma csol_unique:
assumes t1: "t1 ∈ existence_ivl t0 x0"
assumes t2: "t2 ∈ existence_ivl t0 x0"
assumes t: "t ∈ {t0 -- t1}" "t ∈ {t0 -- t2}"
shows "csol t0 x0 t1 t = csol t0 x0 t2 t"
using csols_unique[OF csol_mem_csols[OF t1] csol_mem_csols[OF t2]] t
by simp
lemma flow_vderiv_on_left:
"(flow t0 x0 has_vderiv_on (λx. f x (flow t0 x0 x))) (existence_ivl t0 x0 ∩ {..t0})"
unfolding has_vderiv_on_def
proof safe
fix t
assume t: "t ∈ existence_ivl t0 x0" "t ≤ t0"
with open_existence_ivl
obtain e where "e > 0" and e: "⋀s. s ∈ cball t e ⟹ s ∈ existence_ivl t0 x0"
by (force simp: open_contains_cball)
have csol_eq: "csol t0 x0 (t - e) s = flow t0 x0 s" if "t - e ≤ s" "s ≤ t0" for s
unfolding flow_def
using that ‹0 < e› t e
by (auto simp: cball_def dist_real_def abs_real_def closed_segment_eq_real_ivl subset_iff
intro!: csol_unique in_existence_between_zeroI[of "t - e" x0 s]
split: if_split_asm)
from e[of "t - e"] ‹0 < e› have "t - e ∈ existence_ivl t0 x0" by (auto simp: mem_cball)
let ?l = "existence_ivl t0 x0 ∩ {..t0}"
let ?s = "{t0 -- t - e}"
from csol(4)[OF e[of "t - e"]] ‹0 < e›
have 1: "(csol t0 x0 (t - e) solves_ode f) ?s X"
by (auto simp: mem_cball)
have "t ∈ {t0 -- t - e}" using t ‹0 < e› by (auto simp: closed_segment_eq_real_ivl)
from solves_odeD(1)[OF 1, unfolded has_vderiv_on_def, rule_format, OF this]
have "(csol t0 x0 (t - e) has_vector_derivative f t (csol t0 x0 (t - e) t)) (at t within ?s)" .
also have "at t within ?s = (at t within ?l)"
using t ‹0 < e›
by (intro at_within_nhd[where S="{t - e <..< t0 + 1}"])
(auto simp: closed_segment_eq_real_ivl intro!: in_existence_between_zeroI[OF ‹t - e ∈ existence_ivl t0 x0›])
finally
have "(csol t0 x0 (t - e) has_vector_derivative f t (csol t0 x0 (t - e) t)) (at t within existence_ivl t0 x0 ∩ {..t0})" .
also have "csol t0 x0 (t - e) t = flow t0 x0 t"
using ‹0 < e› ‹t ≤ t0› by (auto intro!: csol_eq)
finally
show "(flow t0 x0 has_vector_derivative f t (flow t0 x0 t)) (at t within existence_ivl t0 x0 ∩ {..t0})"
apply (rule has_vector_derivative_transform_within[where d=e])
using t ‹0 < e›
by (auto intro!: csol_eq simp: dist_real_def)
qed
lemma flow_vderiv_on_right:
"(flow t0 x0 has_vderiv_on (λx. f x (flow t0 x0 x))) (existence_ivl t0 x0 ∩ {t0..})"
unfolding has_vderiv_on_def
proof safe
fix t
assume t: "t ∈ existence_ivl t0 x0" "t0 ≤ t"
with open_existence_ivl
obtain e where "e > 0" and e: "⋀s. s ∈ cball t e ⟹ s ∈ existence_ivl t0 x0"
by (force simp: open_contains_cball)
have csol_eq: "csol t0 x0 (t + e) s = flow t0 x0 s" if "s ≤ t + e" "t0 ≤ s" for s
unfolding flow_def
using e that ‹0 < e›
by (auto simp: cball_def dist_real_def abs_real_def closed_segment_eq_real_ivl subset_iff
intro!: csol_unique in_existence_between_zeroI[of "t + e" x0 s]
split: if_split_asm)
from e[of "t + e"] ‹0 < e› have "t + e ∈ existence_ivl t0 x0" by (auto simp: mem_cball dist_real_def)
let ?l = "existence_ivl t0 x0 ∩ {t0..}"
let ?s = "{t0 -- t + e}"
from csol(4)[OF e[of "t + e"]] ‹0 < e›
have 1: "(csol t0 x0 (t + e) solves_ode f) ?s X"
by (auto simp: dist_real_def mem_cball)
have "t ∈ {t0 -- t + e}" using t ‹0 < e› by (auto simp: closed_segment_eq_real_ivl)
from solves_odeD(1)[OF 1, unfolded has_vderiv_on_def, rule_format, OF this]
have "(csol t0 x0 (t + e) has_vector_derivative f t (csol t0 x0 (t + e) t)) (at t within ?s)" .
also have "at t within ?s = (at t within ?l)"
using t ‹0 < e›
by (intro at_within_nhd[where S="{t0 - 1 <..< t + e}"])
(auto simp: closed_segment_eq_real_ivl intro!: in_existence_between_zeroI[OF ‹t + e ∈ existence_ivl t0 x0›])
finally
have "(csol t0 x0 (t + e) has_vector_derivative f t (csol t0 x0 (t + e) t)) (at t within ?l)" .
also have "csol t0 x0 (t + e) t = flow t0 x0 t"
using ‹0 < e› ‹t0 ≤ t› by (auto intro!: csol_eq)
finally
show "(flow t0 x0 has_vector_derivative f t (flow t0 x0 t)) (at t within ?l)"
apply (rule has_vector_derivative_transform_within[where d=e])
using t ‹0 < e›
by (auto intro!: csol_eq simp: dist_real_def)
qed
lemma flow_usolves_ode:
assumes iv_defined: "t0 ∈ T" "x0 ∈ X"
shows "(flow t0 x0 usolves_ode f from t0) (existence_ivl t0 x0) X"
proof (rule usolves_odeI)
let ?l = "existence_ivl t0 x0 ∩ {..t0}" and ?r = "existence_ivl t0 x0 ∩ {t0..}"
let ?split = "?l ∪ ?r"
have insert_idem: "insert t0 ?l = ?l" "insert t0 ?r = ?r" using iv_defined
by auto
from existence_ivl_initial_time have cl_inter: "closure ?l ∩ closure ?r = {t0}"
proof safe
from iv_defined have "t0 ∈ ?l" by simp also note closure_subset finally show "t0 ∈ closure ?l" .
from iv_defined have "t0 ∈ ?r" by simp also note closure_subset finally show "t0 ∈ closure ?r" .
fix x
assume xl: "x ∈ closure ?l"
assume "x ∈ closure ?r"
also have "closure ?r ⊆ closure {t0..}"
by (rule closure_mono) simp
finally have "t0 ≤ x" by simp
moreover
{
note xl
also have cl: "closure ?l ⊆ closure {..t0}"
by (rule closure_mono) simp
finally have "x ≤ t0" by simp
} ultimately show "x = t0" by simp
qed
have "(flow t0 x0 has_vderiv_on (λt. f t (flow t0 x0 t))) ?split"
by (rule has_vderiv_on_union)
(auto simp: cl_inter insert_idem flow_vderiv_on_right flow_vderiv_on_left)
also have "?split = existence_ivl t0 x0"
by auto
finally have "(flow t0 x0 has_vderiv_on (λt. f t (flow t0 x0 t))) (existence_ivl t0 x0)" .
moreover
have "flow t0 x0 t ∈ X" if "t ∈ existence_ivl t0 x0" for t
using solves_odeD(2)[OF csol(4)[OF that]] that
by (simp add: flow_def)
ultimately show "(flow t0 x0 solves_ode f) (existence_ivl t0 x0) X"
by (rule solves_odeI)
show "t0 ∈ existence_ivl t0 x0" using iv_defined by simp
show "is_interval (existence_ivl t0 x0)" by (simp add: is_interval_existence_ivl)
fix z t
assume z: "{t0 -- t} ⊆ existence_ivl t0 x0" "(z solves_ode f) {t0 -- t} X" "z t0 = flow t0 x0 t0"
then have "t ∈ existence_ivl t0 x0" by auto
moreover
from csol[OF this] z have "(z, t) ∈ csols t0 x0" by (auto simp: csols_def)
moreover have "(csol t0 x0 t, t) ∈ csols t0 x0"
by (rule csol_mem_csols) fact
ultimately
show "z t = flow t0 x0 t"
unfolding flow_def
by (auto intro: csols_unique[rule_format])
qed
lemma flow_solves_ode: "t0 ∈ T ⟹ x0 ∈ X ⟹ (flow t0 x0 solves_ode f) (existence_ivl t0 x0) X"
by (rule usolves_odeD[OF flow_usolves_ode])
lemma equals_flowI:
assumes "t0 ∈ T'"
"is_interval T'"
"T' ⊆ existence_ivl t0 x0"
"(z solves_ode f) T' X"
"z t0 = flow t0 x0 t0" "t ∈ T'"
shows "z t = flow t0 x0 t"
proof -
from assms have iv_defined: "t0 ∈ T" "x0 ∈ X"
unfolding atomize_conj
using assms existence_ivl_subset mem_existence_ivl_iv_defined
by blast
show ?thesis
using assms
by (rule usolves_odeD[OF flow_usolves_ode[OF iv_defined]])
qed
lemma existence_ivl_maximal_segment:
assumes "(x solves_ode f) {t0 -- t} X" "x t0 = x0"
assumes "{t0 -- t} ⊆ T"
shows "t ∈ existence_ivl t0 x0"
using assms
by (auto simp: existence_ivl_def csols_def)
lemma existence_ivl_maximal_interval:
assumes "(x solves_ode f) S X" "x t0 = x0"
assumes "t0 ∈ S" "is_interval S" "S ⊆ T"
shows "S ⊆ existence_ivl t0 x0"
proof
fix t assume "t ∈ S"
with assms have subset1: "{t0--t} ⊆ S"
by (intro closed_segment_subset) (auto simp: is_interval_convex_1)
with ‹S ⊆ T› have subset2: "{t0 -- t} ⊆ T" by auto
have "(x solves_ode f) {t0 -- t} X"
using assms(1) subset1 order_refl
by (rule solves_ode_on_subset)
from this ‹x t0 = x0› subset2 show "t ∈ existence_ivl t0 x0"
by (rule existence_ivl_maximal_segment)
qed
lemma maximal_existence_flow:
assumes sol: "(x solves_ode f) K X" and iv: "x t0 = x0"
assumes "is_interval K"
assumes "t0 ∈ K"
assumes "K ⊆ T"
shows "K ⊆ existence_ivl t0 x0" "⋀t. t ∈ K ⟹ flow t0 x0 t = x t"
proof -
from assms have iv_defined: "t0 ∈ T" "x0 ∈ X"
unfolding atomize_conj
using solves_ode_domainD by blast
show exivl: "K ⊆ existence_ivl t0 x0"
by (rule existence_ivl_maximal_interval; rule assms)
show "flow t0 x0 t = x t" if "t ∈ K" for t
apply (rule sym)
apply (rule equals_flowI[OF ‹t0 ∈ K› ‹is_interval K› exivl sol _ that])
by (simp add: iv iv_defined)
qed
lemma maximal_existence_flowI:
assumes "(x has_vderiv_on (λt. f t (x t))) K"
assumes "⋀t. t ∈ K ⟹ x t ∈ X"
assumes "x t0 = x0"
assumes K: "is_interval K" "t0 ∈ K" "K ⊆ T"
shows "K ⊆ existence_ivl t0 x0" "⋀t. t ∈ K ⟹ flow t0 x0 t = x t"
proof -
from assms(1,2) have sol: "(x solves_ode f) K X" by (rule solves_odeI)
from maximal_existence_flow[OF sol assms(3) K]
show "K ⊆ existence_ivl t0 x0" "⋀t. t ∈ K ⟹ flow t0 x0 t = x t"
by auto
qed
lemma flow_in_domain: "t ∈ existence_ivl t0 x0 ⟹ flow t0 x0 t ∈ X"
using flow_solves_ode solves_ode_domainD local.mem_existence_ivl_iv_defined
by blast
lemma (in ll_on_open)
assumes "t ∈ existence_ivl s x"
assumes "x ∈ X"
assumes auto: "⋀s t x. x ∈ X ⟹ f s x = f t x"
assumes "T = UNIV"
shows mem_existence_ivl_shift_autonomous1: "t - s ∈ existence_ivl 0 x"
and flow_shift_autonomous1: "flow s x t = flow 0 x (t - s)"
proof -
have na: "s ∈ T" "x ∈ X" and a: "0 ∈ T" "x ∈ X"
by (auto simp: assms)
have tI[simp]: "t ∈ T" for t by (simp add: assms)
let ?T = "((+) (- s) ` existence_ivl s x)"
have shifted: "is_interval ?T" "0 ∈ ?T"
by (auto simp: ‹x ∈ X›)
have "(λt. t - s) = (+) (- s)" by auto
with shift_autonomous_solution[OF flow_solves_ode[OF na], of s] flow_in_domain
have sol: "((λt. flow s x (t + s)) solves_ode f) ?T X"
by (auto simp: auto ‹x ∈ X›)
have "flow s x (0 + s) = x" using ‹x ∈ X› flow_initial_time by simp
from maximal_existence_flow[OF sol this shifted]
have *: "?T ⊆ existence_ivl 0 x"
and **: "⋀t. t ∈ ?T ⟹ flow 0 x t = flow s x (t + s)"
by (auto simp: subset_iff)
have "t - s ∈ ?T"
using ‹t ∈ existence_ivl s x›
by auto
also note *
finally show "t - s ∈ existence_ivl 0 x" .
show "flow s x t = flow 0 x (t - s)"
using ‹t ∈ existence_ivl s x›
by (auto simp: **)
qed
lemma (in ll_on_open)
assumes "t - s ∈ existence_ivl 0 x"
assumes "x ∈ X"
assumes auto: "⋀s t x. x ∈ X ⟹ f s x = f t x"
assumes "T = UNIV"
shows mem_existence_ivl_shift_autonomous2: "t ∈ existence_ivl s x"
and flow_shift_autonomous2: "flow s x t = flow 0 x (t - s)"
proof -
have na: "s ∈ T" "x ∈ X" and a: "0 ∈ T" "x ∈ X"
by (auto simp: assms)
let ?T = "((+) s ` existence_ivl 0 x)"
have shifted: "is_interval ?T" "s ∈ ?T"
by (auto simp: a)
have "(λt. t + s) = (+) s"
by (auto simp: )
with shift_autonomous_solution[OF flow_solves_ode[OF a], of "-s"]
flow_in_domain
have sol: "((λt. flow 0 x (t - s)) solves_ode f) ?T X"
by (auto simp: auto algebra_simps)
have "flow 0 x (s - s) = x"
by (auto simp: a)
from maximal_existence_flow[OF sol this shifted]
have *: "?T ⊆ existence_ivl s x"
and **: "⋀t. t ∈ ?T ⟹ flow s x t = flow 0 x (t - s)"
by (auto simp: subset_iff assms)
have "t ∈ ?T"
using ‹t - s ∈ existence_ivl 0 x›
by force
also note *
finally show "t ∈ existence_ivl s x" .
show "flow s x t = flow 0 x (t - s)"
using ‹t - s ∈ existence_ivl _ _›
by (subst **; force)
qed
lemma
flow_eq_rev:
assumes "t ∈ existence_ivl t0 x0"
shows "preflect t0 t ∈ ll_on_open.existence_ivl (preflect t0 ` T) (λt. - f (preflect t0 t)) X t0 x0"
"flow t0 x0 t = ll_on_open.flow (preflect t0 ` T) (λt. - f (preflect t0 t)) X t0 x0 (preflect t0 t)"
proof -
from mem_existence_ivl_iv_defined[OF assms] have mt0: "t0 ∈ preflect t0 ` existence_ivl t0 x0"
by (auto simp: preflect_def)
have subset: "preflect t0 ` existence_ivl t0 x0 ⊆ preflect t0 ` T"
using existence_ivl_subset
by (rule image_mono)
from mt0 subset have "t0 ∈ preflect t0 ` T" by auto
have sol: "((λt. flow t0 x0 (preflect t0 t)) solves_ode (λt. - f (preflect t0 t))) (preflect t0 ` existence_ivl t0 x0) X"
using mt0
by (rule preflect_solution) (auto simp: image_image flow_solves_ode mem_existence_ivl_iv_defined[OF assms])
have flow0: "flow t0 x0 (preflect t0 t0) = x0" and ivl: "is_interval (preflect t0 ` existence_ivl t0 x0)"
by (auto simp: preflect_def mem_existence_ivl_iv_defined[OF assms])
interpret rev: ll_on_open "(preflect t0 ` T)" "(λt. - f (preflect t0 t))" X ..
from rev.maximal_existence_flow[OF sol flow0 ivl mt0 subset]
show "preflect t0 t ∈ rev.existence_ivl t0 x0" "flow t0 x0 t = rev.flow t0 x0 (preflect t0 t)"
using assms by (auto simp: preflect_def)
qed
lemma (in ll_on_open)
shows rev_flow_eq: "t ∈ ll_on_open.existence_ivl (preflect t0 ` T) (λt. - f (preflect t0 t)) X t0 x0 ⟹
ll_on_open.flow (preflect t0 ` T) (λt. - f (preflect t0 t)) X t0 x0 t = flow t0 x0 (preflect t0 t)"
and mem_rev_existence_ivl_eq:
"t ∈ ll_on_open.existence_ivl (preflect t0 ` T) (λt. - f (preflect t0 t)) X t0 x0 ⟷ preflect t0 t ∈ existence_ivl t0 x0"
proof -
interpret rev: ll_on_open "(preflect t0 ` T)" "(λt. - f (preflect t0 t))" X ..
from rev.flow_eq_rev[of _ t0 x0] flow_eq_rev[of "2 * t0 - t" t0 x0]
show "t ∈ rev.existence_ivl t0 x0 ⟹ rev.flow t0 x0 t = flow t0 x0 (preflect t0 t)"
"(t ∈ rev.existence_ivl t0 x0) = (preflect t0 t ∈ existence_ivl t0 x0)"
by (auto simp: preflect_def fun_Compl_def image_image dest: mem_existence_ivl_iv_defined
rev.mem_existence_ivl_iv_defined)
qed
lemma
shows rev_existence_ivl_eq: "ll_on_open.existence_ivl (preflect t0 ` T) (λt. - f (preflect t0 t)) X t0 x0 = preflect t0 ` existence_ivl t0 x0"
and existence_ivl_eq_rev: "existence_ivl t0 x0 = preflect t0 ` ll_on_open.existence_ivl (preflect t0 ` T) (λt. - f (preflect t0 t)) X t0 x0"
apply safe
subgoal by (force simp: mem_rev_existence_ivl_eq)
subgoal by (force simp: mem_rev_existence_ivl_eq)
subgoal for x by (force intro!: image_eqI[where x="preflect t0 x"] simp: mem_rev_existence_ivl_eq)
subgoal by (force simp: mem_rev_existence_ivl_eq)
done
end
end
Theory Bounded_Linear_Operator
section ‹Bounded Linear Operator›
theory Bounded_Linear_Operator
imports
"HOL-Analysis.Analysis"
begin
typedef (overloaded) 'a blinop = "UNIV::('a, 'a) blinfun set"
by simp
setup_lifting type_definition_blinop
lift_definition blinop_apply::"('a::real_normed_vector) blinop ⇒ 'a ⇒ 'a" is blinfun_apply .
lift_definition Blinop::"('a::real_normed_vector ⇒ 'a) ⇒ 'a blinop" is Blinfun .
no_notation vec_nth (infixl "$" 90)
notation blinop_apply (infixl "$" 999)
declare [[coercion "blinop_apply :: ('a::real_normed_vector) blinop ⇒ 'a ⇒ 'a"]]
instantiation blinop :: (real_normed_vector) real_normed_vector
begin
lift_definition norm_blinop :: "'a blinop ⇒ real" is norm .
lift_definition minus_blinop :: "'a blinop ⇒ 'a blinop ⇒ 'a blinop" is minus .
lift_definition dist_blinop :: "'a blinop ⇒ 'a blinop ⇒ real" is dist .
definition uniformity_blinop :: "('a blinop × 'a blinop) filter" where
"uniformity_blinop = (INF e∈{0<..}. principal {(x, y). dist x y < e})"
definition open_blinop :: "'a blinop set ⇒ bool" where
"open_blinop U = (∀x∈U. ∀⇩F (x', y) in uniformity. x' = x ⟶ y ∈ U)"
lift_definition uminus_blinop :: "'a blinop ⇒ 'a blinop" is uminus .
lift_definition zero_blinop :: "'a blinop" is 0 .
lift_definition plus_blinop :: "'a blinop ⇒ 'a blinop ⇒ 'a blinop" is plus .
lift_definition scaleR_blinop::"real ⇒ 'a blinop ⇒ 'a blinop" is scaleR .
lift_definition sgn_blinop :: "'a blinop ⇒ 'a blinop" is sgn .
instance
apply standard
apply (transfer', simp add: algebra_simps sgn_div_norm open_uniformity norm_triangle_le
uniformity_blinop_def dist_norm
open_blinop_def)+
done
end
lemma bounded_bilinear_blinop_apply: "bounded_bilinear ($)"
unfolding bounded_bilinear_def
by transfer (simp add: blinfun.bilinear_simps blinfun.bounded)
interpretation blinop: bounded_bilinear "($)"
by (rule bounded_bilinear_blinop_apply)
lemma blinop_eqI: "(⋀i. x $ i = y $ i) ⟹ x = y"
by transfer (rule blinfun_eqI)
lemmas bounded_linear_apply_blinop[intro, simp] = blinop.bounded_linear_left
declare blinop.tendsto[tendsto_intros]
declare blinop.FDERIV[derivative_intros]
declare blinop.continuous[continuous_intros]
declare blinop.continuous_on[continuous_intros]
instance blinop :: (banach) banach
apply standard
unfolding convergent_def LIMSEQ_def Cauchy_def
apply transfer
unfolding convergent_def[symmetric] LIMSEQ_def[symmetric] Cauchy_def[symmetric]
Cauchy_convergent_iff
.
instance blinop :: (euclidean_space) heine_borel
apply standard
unfolding LIMSEQ_def bounded_def
apply transfer
unfolding LIMSEQ_def[symmetric] bounded_def[symmetric]
apply (rule bounded_imp_convergent_subsequence)
.
instantiation blinop::("{real_normed_vector, perfect_space}") real_normed_algebra_1
begin
lift_definition one_blinop::"'a blinop" is id_blinfun .
lemma blinop_apply_one_blinop[simp]: "1 $ x = x"
by transfer simp
lift_definition times_blinop :: "'a blinop ⇒ 'a blinop ⇒ 'a blinop" is blinfun_compose .
lemma blinop_apply_times_blinop[simp]: "(f * g) $ x = f $ (g $ x)"
by transfer simp
instance
proof
from not_open_singleton[of "0::'a"] have "{0::'a} ≠ UNIV" by force
then obtain x :: 'a where "x ≠ 0" by auto
show "0 ≠ (1::'a blinop)"
apply transfer
apply transfer
apply (auto dest!: fun_cong[where x=x] simp: ‹x ≠ 0›)
done
qed (transfer, transfer,
simp add: o_def linear_simps onorm_compose onorm_id onorm_compose[simplified o_def])+
end
lemmas bounded_bilinear_bounded_uniform_limit_intros[uniform_limit_intros] =
bounded_bilinear.bounded_uniform_limit[OF Bounded_Linear_Operator.bounded_bilinear_blinop_apply]
bounded_bilinear.bounded_uniform_limit[OF Bounded_Linear_Function.bounded_bilinear_blinfun_apply]
bounded_bilinear.bounded_uniform_limit[OF Bounded_Linear_Operator.blinop.flip]
bounded_bilinear.bounded_uniform_limit[OF Bounded_Linear_Function.blinfun.flip]
bounded_linear.uniform_limit[OF blinop.bounded_linear_right]
bounded_linear.uniform_limit[OF blinop.bounded_linear_left]
bounded_linear.uniform_limit[OF bounded_linear_apply_blinop]
no_notation
blinop_apply (infixl "$" 999)
notation vec_nth (infixl "$" 90)
end
Theory Multivariate_Taylor
section ‹Multivariate Taylor›
theory Multivariate_Taylor
imports
"HOL-Analysis.Analysis"
"../ODE_Auxiliarities"
begin
no_notation vec_nth (infixl "$" 90)
notation blinfun_apply (infixl "$" 999)
lemma
fixes f::"'a::real_normed_vector ⇒ 'b::banach"
and Df::"'a ⇒ nat ⇒ 'a ⇒ 'a ⇒ 'b"
assumes "n > 0"
assumes Df_Nil: "⋀a x. Df a 0 H H = f a"
assumes Df_Cons: "⋀a i d. a ∈ closed_segment X (X + H) ⟹ i < n ⟹
((λa. Df a i H H) has_derivative (Df a (Suc i) H)) (at a within G)"
assumes cs: "closed_segment X (X + H) ⊆ G"
defines "i ≡ λx.
((1 - x) ^ (n - 1) / fact (n - 1)) *⇩R Df (X + x *⇩R H) n H H"
shows multivariate_Taylor_has_integral:
"(i has_integral f (X + H) - (∑i<n. (1 / fact i) *⇩R Df X i H H)) {0..1}"
and multivariate_Taylor:
"f (X + H) = (∑i<n. (1 / fact i) *⇩R Df X i H H) + integral {0..1} i"
and multivariate_Taylor_integrable:
"i integrable_on {0..1}"
proof goal_cases
case 1
let ?G = "closed_segment X (X + H)"
define line where "line t = X + t *⇩R H" for t
have segment_eq: "closed_segment X (X + H) = line ` {0 .. 1}"
by (auto simp: line_def closed_segment_def algebra_simps)
have line_deriv: "⋀x. (line has_derivative (λt. t *⇩R H)) (at x)"
by (auto intro!: derivative_eq_intros simp: line_def [abs_def])
define g where "g = f o line"
define Dg where "Dg n t = Df (line t) n H H" for n :: nat and t :: real
note ‹n > 0›
moreover
have Dg0: "Dg 0 = g" by (auto simp add: Dg_def Df_Nil g_def)
moreover
have DgSuc: "(Dg m has_vector_derivative Dg (Suc m) t) (at t within {0..1})"
if "m < n" "0 ≤ t" "t ≤ 1" for m::nat and t::real
proof -
from that have [intro]: "line t ∈ ?G" using assms
by (auto simp: segment_eq)
note [derivative_intros] = has_derivative_in_compose[OF _ has_derivative_subset[OF Df_Cons]]
interpret Df: linear "(λd. Df (line t) (Suc m) H d)"
by (auto intro!: has_derivative_linear derivative_intros ‹m < n›)
note [derivative_intros] =
has_derivative_compose[OF _ line_deriv]
show ?thesis
using Df.scaleR ‹m < n›
by (auto simp: Dg_def [abs_def] has_vector_derivative_def g_def segment_eq
intro!: derivative_eq_intros subsetD[OF cs])
qed
ultimately
have g_Taylor: "(i has_integral g 1 - (∑i<n. ((1 - 0) ^ i / fact i) *⇩R Dg i 0)) {0 .. 1}"
unfolding i_def Dg_def [abs_def] line_def
by (rule Taylor_has_integral) auto
then show c: ?case using ‹n > 0› by (auto simp: g_def line_def Dg_def)
case 2 show ?case using c
by (simp add: integral_unique add.commute)
case 3 show ?case using c by force
qed
subsection ‹Symmetric second derivative›
lemma symmetric_second_derivative_aux:
assumes first_fderiv[derivative_intros]:
"⋀a. a ∈ G ⟹ (f has_derivative (f' a)) (at a within G)"
assumes second_fderiv[derivative_intros]:
"⋀i. ((λx. f' x i) has_derivative (λj. f'' j i)) (at a within G)"
assumes "i ≠ j" "i ≠ 0" "j ≠ 0"
assumes "a ∈ G"
assumes "⋀s t. s ∈ {0..1} ⟹ t ∈ {0..1} ⟹ a + s *⇩R i + t *⇩R j ∈ G"
shows "f'' j i = f'' i j"
proof -
let ?F = "at_right (0::real)"
define B where "B i j = {a + s *⇩R i + t *⇩R j |s t. s ∈ {0..1} ∧ t ∈ {0..1}}" for i j
have "B i j ⊆ G" using assms by (auto simp: B_def)
{
fix e::real and i j::'a
assume "e > 0"
assume "i ≠ j" "i ≠ 0" "j ≠ 0"
assume "B i j ⊆ G"
let ?ij' = "λs t. λu. a + (s * u) *⇩R i + (t * u) *⇩R j"
let ?ij = "λt. λu. a + (t * u) *⇩R i + u *⇩R j"
let ?i = "λt. λu. a + (t * u) *⇩R i"
let ?g = "λu t. f (?ij t u) - f (?i t u)"
have filter_ij'I: "⋀P. P a ⟹ eventually P (at a within G) ⟹
eventually (λx. ∀s∈{0..1}. ∀t∈{0..1}. P (?ij' s t x)) ?F"
proof -
fix P
assume "P a"
assume "eventually P (at a within G)"
hence "eventually P (at a within B i j)" by (rule filter_leD[OF at_le[OF ‹B i j ⊆ G›]])
then obtain d where d: "d > 0" and "⋀x d2. x ∈ B i j ⟹ x ≠ a ⟹ dist x a < d ⟹ P x"
by (auto simp: eventually_at)
with ‹P a› have P: "⋀x d2. x ∈ B i j ⟹ dist x a < d ⟹ P x" by (case_tac "x = a") auto
let ?d = "min (min (d/norm i) (d/norm j) / 2) 1"
show "eventually (λx. ∀s∈{0..1}. ∀t∈{0..1}. P (?ij' s t x)) (at_right 0)"
unfolding eventually_at
proof (rule exI[where x="?d"], safe)
show "0 < ?d" using ‹0 < d› ‹i ≠ 0› ‹j ≠ 0› by simp
fix x s t :: real assume *: "s ∈ {0..1}" "t ∈ {0..1}" "0 < x" "dist x 0 < ?d"
show "P (?ij' s t x)"
proof (rule P)
have "⋀x y::real. x ∈ {0..1} ⟹ y ∈ {0..1} ⟹ x * y ∈ {0..1}"
by (auto intro!: order_trans[OF mult_left_le_one_le])
hence "s * x ∈ {0..1}" "t * x ∈ {0..1}" using * by (auto simp: dist_norm)
thus "?ij' s t x ∈ B i j" by (auto simp: B_def)
have "norm (s *⇩R x *⇩R i + t *⇩R x *⇩R j) ≤ norm (s *⇩R x *⇩R i) + norm (t *⇩R x *⇩R j)"
by (rule norm_triangle_ineq)
also have "… < d / 2 + d / 2" using * ‹i ≠ 0› ‹j ≠ 0›
by (intro add_strict_mono) (auto simp: ac_simps dist_norm
pos_less_divide_eq le_less_trans[OF mult_left_le_one_le])
finally show "dist (?ij' s t x) a < d" by (simp add: dist_norm)
qed
qed
qed
have filter_ijI: "eventually (λx. ∀t∈{0..1}. P (?ij t x)) ?F"
if "P a" "eventually P (at a within G)" for P
using filter_ij'I[OF that]
by eventually_elim (force dest: bspec[where x=1])
have filter_iI: "eventually (λx. ∀t∈{0..1}. P (?i t x)) ?F"
if "P a" "eventually P (at a within G)" for P
using filter_ij'I[OF that] by eventually_elim force
{
from second_fderiv[of i, simplified has_derivative_iff_norm, THEN conjunct2,
THEN tendstoD, OF ‹0 < e›]
have "eventually (λx. norm (f' x i - f' a i - f'' (x - a) i) / norm (x - a) ≤ e)
(at a within G)"
by eventually_elim (simp add: dist_norm)
from filter_ijI[OF _ this] filter_iI[OF _ this] ‹0 < e›
have
"eventually (λij. ∀t∈{0..1}. norm (f' (?ij t ij) i - f' a i - f'' (?ij t ij - a) i) /
norm (?ij t ij - a) ≤ e) ?F"
"eventually (λij. ∀t∈{0..1}. norm (f' (?i t ij) i - f' a i - f'' (?i t ij - a) i) /
norm (?i t ij - a) ≤ e) ?F"
by auto
moreover
have "eventually (λx. x ∈ G) (at a within G)" unfolding eventually_at_filter by simp
hence eventually_in_ij: "eventually (λx. ∀t∈{0..1}. ?ij t x ∈ G) ?F" and
eventually_in_i: "eventually (λx. ∀t∈{0..1}. ?i t x ∈ G) ?F"
using ‹a ∈ G› by (auto dest: filter_ijI filter_iI)
ultimately
have "eventually (λu. norm (?g u 1 - ?g u 0 - (u * u) *⇩R f'' j i) ≤
u * u * e * (2 * norm i + 3 * norm j)) ?F"
proof eventually_elim
case (elim u)
hence ijsub: "(λt. ?ij t u) ` {0..1} ⊆ G" and isub: "(λt. ?i t u) ` {0..1} ⊆ G" by auto
note has_derivative_subset[OF _ ijsub, derivative_intros]
note has_derivative_subset[OF _ isub, derivative_intros]
let ?g' = "λt. (λua. u *⇩R ua *⇩R (f' (?ij t u) i - (f' (?i t u) i)))"
have g': "((?g u) has_derivative ?g' t) (at t within {0..1})" if "t ∈ {0..1}" for t::real
proof -
from elim that have linear_f': "⋀c x. f' (?ij t u) (c *⇩R x) = c *⇩R f' (?ij t u) x"
"⋀c x. f' (?i t u) (c *⇩R x) = c *⇩R f' (?i t u) x"
using linear_cmul[OF has_derivative_linear, OF first_fderiv] by auto
show ?thesis
using elim ‹t ∈ {0..1}›
by (auto intro!: derivative_eq_intros has_derivative_in_compose[of "λt. ?ij t u" _ _ _ f]
has_derivative_in_compose[of "λt. ?i t u" _ _ _ f]
simp: linear_f' scaleR_diff_right mult.commute)
qed
from elim(1) ‹i ≠ 0› ‹j ≠ 0› ‹0 < e› have f'ij: "⋀t. t ∈ {0..1} ⟹
norm (f' (a + (t * u) *⇩R i + u *⇩R j) i - f' a i - f'' ((t * u) *⇩R i + u *⇩R j) i) ≤
e * norm ((t * u) *⇩R i + u *⇩R j)"
using linear_0[OF has_derivative_linear, OF second_fderiv]
by (case_tac "u *⇩R j + (t * u) *⇩R i = 0") (auto simp: field_simps
simp del: pos_divide_le_eq simp add: pos_divide_le_eq[symmetric])
from elim(2) have f'i: "⋀t. t ∈ {0..1} ⟹ norm (f' (a + (t * u) *⇩R i) i - f' a i -
f'' ((t * u) *⇩R i) i) ≤ e * abs (t * u) * norm i"
using ‹i ≠ 0› ‹j ≠ 0› linear_0[OF has_derivative_linear, OF second_fderiv]
by (case_tac "t * u = 0") (auto simp: field_simps simp del: pos_divide_le_eq
simp add: pos_divide_le_eq[symmetric])
have "norm (?g u 1 - ?g u 0 - (u * u) *⇩R f'' j i) =
norm ((?g u 1 - ?g u 0 - u *⇩R (f' (a + u *⇩R j) i - (f' a i)))
+ u *⇩R (f' (a + u *⇩R j) i - f' a i - u *⇩R f'' j i))"
(is "_ = norm (?g10 + ?f'i)")
by (simp add: algebra_simps linear_cmul[OF has_derivative_linear, OF second_fderiv]
linear_add[OF has_derivative_linear, OF second_fderiv])
also have "… ≤ norm ?g10 + norm ?f'i"
by (blast intro: order_trans add_mono norm_triangle_le)
also
have "0 ∈ {0..1::real}" by simp
have "∀t ∈ {0..1}. onorm ((λua. (u * ua) *⇩R (f' (?ij t u) i - f' (?i t u) i)) -
(λua. (u * ua) *⇩R (f' (a + u *⇩R j) i - f' a i)))
≤ 2 * u * u * e * (norm i + norm j)" (is "∀t ∈ _. onorm (?d t) ≤ _")
proof
fix t::real assume "t ∈ {0..1}"
show "onorm (?d t) ≤ 2 * u * u * e * (norm i + norm j)"
proof (rule onorm_le)
fix x
have "norm (?d t x) =
norm ((u * x) *⇩R (f' (?ij t u) i - f' (?i t u) i - f' (a + u *⇩R j) i + f' a i))"
by (simp add: algebra_simps)
also have "… =
abs (u * x) * norm (f' (?ij t u) i - f' (?i t u) i - f' (a + u *⇩R j) i + f' a i)"
by simp
also have "… = abs (u * x) * norm (
f' (?ij t u) i - f' a i - f'' ((t * u) *⇩R i + u *⇩R j) i
- (f' (?i t u) i - f' a i - f'' ((t * u) *⇩R i) i)
- (f' (a + u *⇩R j) i - f' a i - f'' (u *⇩R j) i))"
(is "_ = _ * norm (?dij - ?di - ?dj)")
using ‹a ∈ G›
by (simp add: algebra_simps
linear_add[OF has_derivative_linear[OF second_fderiv]])
also have "… ≤ abs (u * x) * (norm ?dij + norm ?di + norm ?dj)"
by (rule mult_left_mono[OF _ abs_ge_zero]) norm
also have "… ≤ abs (u * x) *
(e * norm ((t * u) *⇩R i + u *⇩R j) + e * abs (t * u) * norm i + e * (¦u¦ * norm j))"
using f'ij f'i f'ij[OF ‹0 ∈ {0..1}›] ‹t ∈ {0..1}›
by (auto intro!: add_mono mult_left_mono)
also have "… = abs u * abs x * abs u *
(e * norm (t *⇩R i + j) + e * norm (t *⇩R i) + e * (norm j))"
by (simp add: algebra_simps norm_scaleR[symmetric] abs_mult del: norm_scaleR)
also have "… =
u * u * abs x * (e * norm (t *⇩R i + j) + e * norm (t *⇩R i) + e * (norm j))"
by (simp add: ac_simps)
also have "… = u * u * e * abs x * (norm (t *⇩R i + j) + norm (t *⇩R i) + norm j)"
by (simp add: algebra_simps)
also have "… ≤ u * u * e * abs x * ((norm (1 *⇩R i) + norm j) + norm (1 *⇩R i) + norm j)"
using ‹t ∈ {0..1}› ‹0 < e›
by (intro mult_left_mono add_mono) (auto intro!: norm_triangle_le add_right_mono
mult_left_le_one_le zero_le_square)
finally show "norm (?d t x) ≤ 2 * u * u * e * (norm i + norm j) * norm x"
by (simp add: ac_simps)
qed
qed
with differentiable_bound_linearization[where f="?g u" and f'="?g'", of 0 1 _ 0, OF _ g']
have "norm ?g10 ≤ 2 * u * u * e * (norm i + norm j)" by simp
also have "norm ?f'i ≤ abs u *
norm ((f' (a + (u) *⇩R j) i - f' a i - f'' (u *⇩R j) i))"
using linear_cmul[OF has_derivative_linear, OF second_fderiv]
by simp
also have "… ≤ abs u * (e * norm ((u) *⇩R j))"
using f'ij[OF ‹0 ∈ {0..1}›] by (auto intro: mult_left_mono)
also have "… = u * u * e * norm j" by (simp add: algebra_simps abs_mult)
finally show ?case by (simp add: algebra_simps)
qed
}
} note wlog = this
have e': "norm (f'' j i - f'' i j) ≤ e * (5 * norm j + 5 * norm i)" if "0 < e" for e t::real
proof -
have "B i j = B j i" using ‹i ≠ j› by (force simp: B_def)+
with assms ‹B i j ⊆ G› have "j ≠ i" "B j i ⊆ G" by (auto simp:)
from wlog[OF ‹0 < e› ‹i ≠ j› ‹i ≠ 0› ‹j ≠ 0› ‹B i j ⊆ G›]
wlog[OF ‹0 < e› ‹j ≠ i› ‹j ≠ 0› ‹i ≠ 0› ‹B j i ⊆ G›]
have "eventually (λu. norm ((u * u) *⇩R f'' j i - (u * u) *⇩R f'' i j)
≤ u * u * e * (5 * norm j + 5 * norm i)) ?F"
proof eventually_elim
case (elim u)
have "norm ((u * u) *⇩R f'' j i - (u * u) *⇩R f'' i j) =
norm (f (a + u *⇩R j + u *⇩R i) - f (a + u *⇩R j) -
(f (a + u *⇩R i) - f a) - (u * u) *⇩R f'' i j
- (f (a + u *⇩R i + u *⇩R j) - f (a + u *⇩R i) -
(f (a + u *⇩R j) - f a) -
(u * u) *⇩R f'' j i))" by (simp add: field_simps)
also have "… ≤ u * u * e * (2 * norm j + 3 * norm i) + u * u * e * (3 * norm j + 2 * norm i)"
using elim by (intro order_trans[OF norm_triangle_ineq4]) (auto simp: ac_simps intro: add_mono)
finally show ?case by (simp add: algebra_simps)
qed
hence "eventually (λu. norm ((u * u) *⇩R (f'' j i - f'' i j)) ≤
u * u * e * (5 * norm j + 5 * norm i)) ?F"
by (simp add: algebra_simps)
hence "eventually (λu. (u * u) * norm ((f'' j i - f'' i j)) ≤
(u * u) * (e * (5 * norm j + 5 * norm i))) ?F"
by (simp add: ac_simps)
hence "eventually (λu. norm ((f'' j i - f'' i j)) ≤ e * (5 * norm j + 5 * norm i)) ?F"
unfolding mult_le_cancel_left eventually_at_filter
by eventually_elim auto
then show ?thesis
by (auto simp add:eventually_at dist_norm dest!: bspec[where x="d/2" for d])
qed
have e: "norm (f'' j i - f'' i j) < e" if "0 < e" for e::real
proof -
let ?e = "e/2/(5 * norm j + 5 * norm i)"
have "?e > 0" using ‹0 < e› ‹i ≠ 0› ‹j ≠ 0› by (auto intro!: divide_pos_pos add_pos_pos)
from e'[OF this] have "norm (f'' j i - f'' i j) ≤ ?e * (5 * norm j + 5 * norm i)" .
also have "… = e / 2" using ‹i ≠ 0› ‹j ≠ 0› by (auto simp: ac_simps add_nonneg_eq_0_iff)
also have "… < e" using ‹0 < e› by simp
finally show ?thesis .
qed
have "norm (f'' j i - f'' i j) = 0"
proof (rule ccontr)
assume "norm (f'' j i - f'' i j) ≠ 0"
hence "norm (f'' j i - f'' i j) > 0" by simp
from e[OF this] show False by simp
qed
thus ?thesis by simp
qed
locale second_derivative_within =
fixes f f' f'' a G
assumes first_fderiv[derivative_intros]:
"⋀a. a ∈ G ⟹ (f has_derivative blinfun_apply (f' a)) (at a within G)"
assumes in_G: "a ∈ G"
assumes second_fderiv[derivative_intros]:
"(f' has_derivative blinfun_apply f'') (at a within G)"
begin
lemma symmetric_second_derivative_within:
assumes "a ∈ G"
assumes "⋀s t. s ∈ {0..1} ⟹ t ∈ {0..1} ⟹ a + s *⇩R i + t *⇩R j ∈ G"
shows "f'' i j = f'' j i"
apply (cases "i = j ∨ i = 0 ∨ j = 0")
apply (force simp add: blinfun.zero_right blinfun.zero_left)
using first_fderiv _ _ _ _ assms
by (rule symmetric_second_derivative_aux[symmetric])
(auto intro!: derivative_eq_intros simp: blinfun.bilinear_simps assms)
end
locale second_derivative =
fixes f::"'a::real_normed_vector ⇒ 'b::banach"
and f' :: "'a ⇒ 'a ⇒⇩L 'b"
and f'' :: "'a ⇒⇩L 'a ⇒⇩L 'b"
and a :: 'a
and G :: "'a set"
assumes first_fderiv[derivative_intros]:
"⋀a. a ∈ G ⟹ (f has_derivative f' a) (at a)"
assumes in_G: "a ∈ interior G"
assumes second_fderiv[derivative_intros]:
"(f' has_derivative f'') (at a)"
begin
lemma symmetric_second_derivative:
assumes "a ∈ interior G"
shows "f'' i j = f'' j i"
proof -
from assms have "a ∈ G"
using interior_subset by blast
interpret second_derivative_within
by unfold_locales
(auto intro!: derivative_intros intro: has_derivative_at_withinI ‹a ∈ G›)
from assms open_interior[of G] interior_subset[of G]
obtain e where e: "e > 0" "⋀y. dist y a < e ⟹ y ∈ G"
by (force simp: open_dist)
define e' where "e' = e / 3"
define i' j' where "i' = e' *⇩R i /⇩R norm i" and "j' = e' *⇩R j /⇩R norm j"
hence "norm i' ≤ e'" "norm j' ≤ e'"
by (auto simp: field_simps e'_def ‹0 < e› less_imp_le)
hence "¦s¦ ≤ 1 ⟹ ¦t¦ ≤ 1 ⟹ norm (s *⇩R i' + t *⇩R j') ≤ e' + e'" for s t
by (intro norm_triangle_le[OF add_mono])
(auto intro!: order_trans[OF mult_left_le_one_le])
also have "… < e" by (simp add: e'_def ‹0 < e›)
finally
have "f'' $ i' $ j' = f'' $ j' $ i'"
by (intro symmetric_second_derivative_within ‹a ∈ G› e)
(auto simp add: dist_norm)
thus ?thesis
using e(1)
by (auto simp: i'_def j'_def e'_def
blinfun.zero_right blinfun.zero_left
blinfun.scaleR_left blinfun.scaleR_right algebra_simps)
qed
end
lemma
uniform_explicit_remainder_Taylor_1:
fixes f::"'a::{banach,heine_borel,perfect_space} ⇒ 'b::banach"
assumes f'[derivative_intros]: "⋀x. x ∈ G ⟹ (f has_derivative blinfun_apply (f' x)) (at x)"
assumes f'_cont: "⋀x. x ∈ G ⟹ isCont f' x"
assumes "open G"
assumes "J ≠ {}" "compact J" "J ⊆ G"
assumes "e > 0"
obtains d R
where "d > 0"
"⋀x z. f z = f x + f' x (z - x) + R x z"
"⋀x y. x ∈ J ⟹ y ∈ J ⟹ dist x y < d ⟹ norm (R x y) ≤ e * dist x y"
"continuous_on (G × G) (λ(a, b). R a b)"
proof -
from assms have "continuous_on G f'" by (auto intro!: continuous_at_imp_continuous_on)
note [continuous_intros] = continuous_on_compose2[OF this]
define R where "R x z = f z - f x - f' x (z - x)" for x z
from compact_in_open_separated[OF ‹J ≠ {}› ‹compact J› ‹open G› ‹J ⊆ G›]
obtain η where η: "0 < η" "{x. infdist x J ≤ η} ⊆ G" (is "?J' ⊆ _")
by auto
hence infdist_in_G: "infdist x J ≤ η ⟹ x ∈ G" for x
by auto
have dist_in_G: "⋀y. dist x y < η ⟹ y ∈ G" if "x ∈ J" for x
by (auto intro!: infdist_in_G infdist_le2 that simp: dist_commute)
have "compact ?J'" by (rule compact_infdist_le; fact)
let ?seg = ?J'
from ‹continuous_on G f'›
have ucont: "uniformly_continuous_on ?seg f'"
using ‹?seg ⊆ G›
by (auto intro!: compact_uniformly_continuous ‹compact ?seg› intro: continuous_on_subset)
define e' where "e' = e / 2"
have "e' > 0" using ‹e > 0› by (simp add: e'_def)
from ucont[unfolded uniformly_continuous_on_def, rule_format, OF ‹0 < e'›]
obtain du where du:
"du > 0"
"⋀x y. x ∈ ?seg ⟹ y ∈ ?seg ⟹ dist x y < du ⟹ norm (f' x - f' y) < e'"
by (auto simp: dist_norm)
have "min η du > 0" using ‹du > 0› ‹η > 0› by simp
moreover
have "f z = f x + f' x (z - x) + R x z" for x z
by (auto simp: R_def)
moreover
{
fix x z::'a
assume "x ∈ J" "z ∈ J"
hence "x ∈ G" "z ∈ G" using assms by auto
assume "dist x z < min η du"
hence d_eta: "dist x z < η" and d_du: "dist x z < du"
by (auto simp add: min_def split: if_split_asm)
from ‹dist x z < η› have line_in:
"⋀xa. 0 ≤ xa ⟹ xa ≤ 1 ⟹ x + xa *⇩R (z - x) ∈ G"
"(λxa. x + xa *⇩R (z - x)) ` {0..1} ⊆ G"
by (auto intro!: dist_in_G ‹x ∈ J› le_less_trans[OF mult_left_le_one_le]
simp: dist_norm norm_minus_commute)
have "R x z = f z - f x - f' x (z - x)"
by (simp add: R_def)
also have "f z - f x = f (x + (z - x)) - f x" by simp
also have "f (x + (z - x)) - f x = integral {0..1} (λt. (f' (x + t *⇩R (z - x))) (z - x))"
using ‹dist x z < η›
by (intro mvt_integral[of "ball x η" f f' x "z - x"])
(auto simp: dist_norm norm_minus_commute at_within_ball ‹0 < η› mem_ball
intro!: le_less_trans[OF mult_left_le_one_le] derivative_eq_intros dist_in_G ‹x ∈ J›)
also have
"(integral {0..1} (λt. (f' (x + t *⇩R (z - x))) (z - x)) - (f' x) (z - x)) =
integral {0..1} (λt. f' (x + t *⇩R (z - x)) - f' x) (z - x)"
by (simp add: Henstock_Kurzweil_Integration.integral_diff integral_linear[where h="λy. blinfun_apply y (z - x)", simplified o_def]
integrable_continuous_real continuous_intros line_in
blinfun.bilinear_simps[symmetric])
finally have "R x z = integral {0..1} (λt. f' (x + t *⇩R (z - x)) - f' x) (z - x)"
.
also have "norm … ≤ norm (integral {0..1} (λt. f' (x + t *⇩R (z - x)) - f' x)) * norm (z - x)"
by (auto intro!: order_trans[OF norm_blinfun])
also have "… ≤ e' * (1 - 0) * norm (z - x)"
using d_eta d_du ‹0 < η›
by (intro mult_right_mono integral_bound)
(auto simp: dist_norm norm_minus_commute
intro!: line_in du[THEN less_imp_le] infdist_le2[OF ‹x ∈ J›] line_in continuous_intros
order_trans[OF mult_left_le_one_le] le_less_trans[OF mult_left_le_one_le])
also have "… ≤ e * dist x z" using ‹0 < e› by (simp add: e'_def norm_minus_commute dist_norm)
finally have "norm (R x z) ≤ e * dist x z" .
}
moreover
{
from f' have f_cont: "continuous_on G f"
by (rule has_derivative_continuous_on[OF has_derivative_at_withinI])
note [continuous_intros] = continuous_on_compose2[OF this]
from f'_cont have f'_cont: "continuous_on G f'"
by (auto intro!: continuous_at_imp_continuous_on)
note continuous_on_diff2=continuous_on_diff[OF continuous_on_compose[OF continuous_on_snd] continuous_on_compose[OF continuous_on_fst], where s="G × G", simplified]
have "continuous_on (G × G) (λ(a, b). f b - f a)"
by (auto intro!: continuous_intros simp: split_beta)
moreover have "continuous_on (G × G) (λ(a, b). f' a (b - a))"
by (auto intro!: continuous_intros simp: split_beta')
ultimately have "continuous_on (G × G) (λ(a, b). R a b)"
by (rule iffD1[OF continuous_on_cong[OF refl] continuous_on_diff, rotated], auto simp: R_def)
}
ultimately
show thesis ..
qed
text ‹TODO: rename, duplication?›
locale second_derivative_within' =
fixes f f' f'' a G
assumes first_fderiv[derivative_intros]:
"⋀a. a ∈ G ⟹ (f has_derivative f' a) (at a within G)"
assumes in_G: "a ∈ G"
assumes second_fderiv[derivative_intros]:
"⋀i. ((λx. f' x i) has_derivative f'' i) (at a within G)"
begin
lemma symmetric_second_derivative_within:
assumes "a ∈ G" "open G"
assumes "⋀s t. s ∈ {0..1} ⟹ t ∈ {0..1} ⟹ a + s *⇩R i + t *⇩R j ∈ G"
shows "f'' i j = f'' j i"
proof (cases "i = j ∨ i = 0 ∨ j = 0")
case True
interpret bounded_linear "f'' k" for k
by (rule has_derivative_bounded_linear) (rule second_fderiv)
have z1: "f'' j 0 = 0" "f'' i 0 = 0" by (simp_all add: zero)
have f'z: "f' x 0 = 0" if "x ∈ G" for x
proof -
interpret bounded_linear "f' x"
by (rule has_derivative_bounded_linear) (rule first_fderiv that)+
show ?thesis by (simp add: zero)
qed
note aw = at_within_open[OF ‹a ∈ G› ‹open G›]
have "((λx. f' x 0) has_derivative (λ_. 0)) (at a within G)"
apply (rule has_derivative_transform_within)
apply (rule has_derivative_const[where c=0])
apply (rule zero_less_one)
apply fact
by (simp add: f'z)
from has_derivative_unique[OF second_fderiv[unfolded aw] this[unfolded aw]]
have "f'' 0 = (λ_. 0)" .
with True z1 show ?thesis
by (auto)
next
case False
show ?thesis
using first_fderiv _ _ _ _ assms(1,3-)
by (rule symmetric_second_derivative_aux[])
(use False in ‹auto intro!: derivative_eq_intros simp: blinfun.bilinear_simps assms›)
qed
end
locale second_derivative_on_open =
fixes f::"'a::real_normed_vector ⇒ 'b::banach"
and f' :: "'a ⇒ 'a ⇒ 'b"
and f'' :: "'a ⇒ 'a ⇒ 'b"
and a :: 'a
and G :: "'a set"
assumes first_fderiv[derivative_intros]:
"⋀a. a ∈ G ⟹ (f has_derivative f' a) (at a)"
assumes in_G: "a ∈ G" and open_G: "open G"
assumes second_fderiv[derivative_intros]:
"((λx. f' x i) has_derivative f'' i) (at a)"
begin
lemma symmetric_second_derivative:
assumes "a ∈ G"
shows "f'' i j = f'' j i"
proof -
interpret second_derivative_within'
by unfold_locales
(auto intro!: derivative_intros intro: has_derivative_at_withinI ‹a ∈ G›)
from ‹a ∈ G› open_G
obtain e where e: "e > 0" "⋀y. dist y a < e ⟹ y ∈ G"
by (force simp: open_dist)
define e' where "e' = e / 3"
define i' j' where "i' = e' *⇩R i /⇩R norm i" and "j' = e' *⇩R j /⇩R norm j"
hence "norm i' ≤ e'" "norm j' ≤ e'"
by (auto simp: field_simps e'_def ‹0 < e› less_imp_le)
hence "¦s¦ ≤ 1 ⟹ ¦t¦ ≤ 1 ⟹ norm (s *⇩R i' + t *⇩R j') ≤ e' + e'" for s t
by (intro norm_triangle_le[OF add_mono])
(auto intro!: order_trans[OF mult_left_le_one_le])
also have "… < e" by (simp add: e'_def ‹0 < e›)
finally
have "f'' i' j' = f'' j' i'"
by (intro symmetric_second_derivative_within ‹a ∈ G› e)
(auto simp add: dist_norm open_G)
moreover
interpret f'': bounded_linear "f'' k" for k
by (rule has_derivative_bounded_linear) (rule second_fderiv)
note aw = at_within_open[OF ‹a ∈ G› ‹open G›]
have z1: "f'' j 0 = 0" "f'' i 0 = 0" by (simp_all add: f''.zero)
have f'z: "f' x 0 = 0" if "x ∈ G" for x
proof -
interpret bounded_linear "f' x"
by (rule has_derivative_bounded_linear) (rule first_fderiv that)+
show ?thesis by (simp add: zero)
qed
have "((λx. f' x 0) has_derivative (λ_. 0)) (at a within G)"
apply (rule has_derivative_transform_within)
apply (rule has_derivative_const[where c=0])
apply (rule zero_less_one)
apply fact
by (simp add: f'z)
from has_derivative_unique[OF second_fderiv[unfolded aw] this[unfolded aw]]
have z2: "f'' 0 = (λ_. 0)" .
have "((λa. f' a (r *⇩R x)) has_derivative f'' (r *⇩R x)) (at a within G)"
"((λa. f' a (r *⇩R x)) has_derivative (λy. r *⇩R f'' x y)) (at a within G)"
for r x
subgoal by (rule second_fderiv)
subgoal
proof -
have "((λa. r *⇩R f' a (x)) has_derivative (λy. r *⇩R f'' x y)) (at a within G)"
by (auto intro!: derivative_intros)
then show ?thesis
apply (rule has_derivative_transform[rotated 2])
apply (rule in_G)
subgoal premises prems for a'
proof -
interpret bounded_linear "f' a'"
apply (rule has_derivative_bounded_linear)
by (rule first_fderiv[OF prems])
show ?thesis
by (simp add: scaleR)
qed
done
qed
done
then have "((λa. f' a (r *⇩R x)) has_derivative f'' (r *⇩R x)) (at a)"
"((λa. f' a (r *⇩R x)) has_derivative (λy. r *⇩R f'' x y)) (at a)" for r x
unfolding aw by auto
then have f'z: "f'' (r *⇩R x) = (λy. r *⇩R f'' x y)" for r x
by (rule has_derivative_unique[where f="(λa. f' a (r *⇩R x))"])
ultimately show ?thesis
using e(1)
by (auto simp: i'_def j'_def e'_def f''.scaleR z1 z2
blinfun.zero_right blinfun.zero_left
blinfun.scaleR_left blinfun.scaleR_right algebra_simps)
qed
end
no_notation
blinfun_apply (infixl "$" 999)
notation vec_nth (infixl "$" 90)
end
Theory Flow
section ‹Flow›
theory Flow
imports
Picard_Lindeloef_Qualitative
"HOL-Library.Diagonal_Subsequence"
"../Library/Bounded_Linear_Operator"
"../Library/Multivariate_Taylor"
"../Library/Interval_Integral_HK"
begin
text ‹TODO: extend theorems for dependence on initial time›
subsection ‹simp rules for integrability (TODO: move)›
lemma blinfun_ext: "x = y ⟷ (∀i. blinfun_apply x i = blinfun_apply y i)"
by transfer auto
notation id_blinfun ("1⇩L")
lemma blinfun_inverse_left:
fixes f::"'a::euclidean_space ⇒⇩L 'a" and f'
shows "f o⇩L f' = 1⇩L ⟷ f' o⇩L f = 1⇩L"
by transfer
(auto dest!: bounded_linear.linear simp: id_def[symmetric]
linear_inverse_left)
lemma onorm_zero_blinfun[simp]: "onorm (blinfun_apply 0) = 0"
by transfer (simp add: onorm_zero)
lemma blinfun_compose_1_left[simp]: "x o⇩L 1⇩L = x"
and blinfun_compose_1_right[simp]: "1⇩L o⇩L y = y"
by (auto intro!: blinfun_eqI)
named_theorems integrable_on_simps
lemma integrable_on_refl_ivl[intro, simp]: "g integrable_on {b .. (b::'b::ordered_euclidean_space)}"
and integrable_on_refl_closed_segment[intro, simp]: "h integrable_on closed_segment a a"
using integrable_on_refl by auto
lemma integrable_const_ivl_closed_segment[intro, simp]: "(λx. c) integrable_on closed_segment a (b::real)"
by (auto simp: closed_segment_eq_real_ivl)
lemma integrable_ident_ivl[intro, simp]: "(λx. x) integrable_on closed_segment a (b::real)"
and integrable_ident_cbox[intro, simp]: "(λx. x) integrable_on cbox a (b::real)"
by (auto simp: closed_segment_eq_real_ivl ident_integrable_on)
lemma content_closed_segment_real:
fixes a b::real
shows "content (closed_segment a b) = abs (b - a)"
by (auto simp: closed_segment_eq_real_ivl)
lemma integral_const_closed_segment:
fixes a b::real
shows "integral (closed_segment a b) (λx. c) = abs (b - a) *⇩R c"
by (auto simp: closed_segment_eq_real_ivl content_closed_segment_real)
lemmas [integrable_on_simps] =
integrable_on_empty
integrable_on_refl integrable_on_refl_ivl integrable_on_refl_closed_segment
integrable_const integrable_const_ivl integrable_const_ivl_closed_segment
ident_integrable_on integrable_ident_ivl integrable_ident_cbox
lemma integrable_cmul_real:
fixes K::real
shows "f integrable_on X ⟹ (λx. K * f x) integrable_on X "
unfolding real_scaleR_def[symmetric]
by (rule integrable_cmul)
lemmas [integrable_on_simps] =
integrable_0
integrable_neg
integrable_cmul
integrable_cmul_real
integrable_on_cmult_iff
integrable_on_cmult_left
integrable_on_cmult_right
integrable_on_cdivide
integrable_on_cmult_iff
integrable_on_cmult_left_iff
integrable_on_cmult_right_iff
integrable_on_cdivide_iff
integrable_diff
integrable_add
integrable_sum
lemma dist_cancel_add1: "dist (t0 + et) t0 = norm et"
by (simp add: dist_norm)
lemma double_nonneg_le:
fixes a::real
shows "a * 2 ≤ b ⟹ a ≥ 0 ⟹ a ≤ b"
by arith
subsection ‹Nonautonomous IVP on maximal existence interval›
context ll_on_open_it
begin
context
fixes x0
assumes iv_defined: "t0 ∈ T" "x0 ∈ X"
begin
lemmas closed_segment_iv_subset_domain = closed_segment_subset_domainI[OF iv_defined(1)]
lemma
local_unique_solutions:
obtains t u L
where
"0 < t" "0 < u"
"cball t0 t ⊆ existence_ivl t0 x0"
"cball x0 (2 * u) ⊆ X"
"⋀t'. t' ∈ cball t0 t ⟹ L-lipschitz_on (cball x0 (2 * u)) (f t')"
"⋀x. x ∈ cball x0 u ⟹ (flow t0 x usolves_ode f from t0) (cball t0 t) (cball x u)"
"⋀x. x ∈ cball x0 u ⟹ cball x u ⊆ X"
proof -
from local_unique_solution[OF iv_defined] obtain et ex B L
where "0 < et" "0 < ex" "cball t0 et ⊆ T" "cball x0 ex ⊆ X"
"unique_on_cylinder t0 (cball t0 et) x0 ex f B L"
by metis
then interpret cyl: unique_on_cylinder t0 "cball t0 et" x0 ex "cball x0 ex" f B L
by auto
from cyl.solution_solves_ode order_refl ‹cball x0 ex ⊆ X›
have "(cyl.solution solves_ode f) (cball t0 et) X"
by (rule solves_ode_on_subset)
then have "cball t0 et ⊆ existence_ivl t0 x0"
by (rule existence_ivl_maximal_interval) (insert ‹cball t0 et ⊆ T› ‹0 < et›, auto)
have "cball t0 et = {t0 - et .. t0 + et}"
using ‹et > 0› by (auto simp: dist_real_def)
then have cylbounds[simp]: "cyl.tmin = t0 - et" "cyl.tmax = t0 + et"
unfolding cyl.tmin_def cyl.tmax_def
using ‹0 < et›
by auto
define et' where "et' ≡ et / 2"
define ex' where "ex' ≡ ex / 2"
have "et' > 0" "ex' > 0" using ‹0 < et› ‹0 < ex› by (auto simp: et'_def ex'_def)
moreover
from ‹cball t0 et ⊆ existence_ivl t0 x0› have "cball t0 et' ⊆ existence_ivl t0 x0"
by (force simp: et'_def dest!: double_nonneg_le)
moreover
from this have "cball t0 et' ⊆ T" using existence_ivl_subset[of x0] by simp
have "cball x0 (2 * ex') ⊆ X" "⋀t'. t' ∈ cball t0 et' ⟹ L-lipschitz_on (cball x0 (2 * ex')) (f t')"
using cyl.lipschitz ‹0 < et› ‹cball x0 ex ⊆ X›
by (auto simp: ex'_def et'_def intro!:)
moreover
{
fix x0'::'a
assume x0': "x0' ∈ cball x0 ex'"
{
fix b
assume d: "dist x0' b ≤ ex'"
have "dist x0 b ≤ dist x0 x0' + dist x0' b"
by (rule dist_triangle)
also have "… ≤ ex' + ex'"
using x0' d by simp
also have "… ≤ ex" by (simp add: ex'_def)
finally have "dist x0 b ≤ ex" .
} note triangle = this
have subs1: "cball t0 et' ⊆ cball t0 et"
and subs2: "cball x0' ex' ⊆ cball x0 ex"
and subs: "cball t0 et' × cball x0' ex' ⊆ cball t0 et × cball x0 ex"
using ‹0 < ex› ‹0 < et› x0'
by (auto simp: ex'_def et'_def triangle dest!: double_nonneg_le)
have subset_X: "cball x0' ex' ⊆ X"
using ‹cball x0 ex ⊆ X› subs2 ‹0 < ex'› by force
then have "x0' ∈ X" using ‹0 < ex'› by force
have x0': "t0 ∈ T" "x0' ∈ X" by fact+
have half_intros: "a ≤ ex' ⟹ a ≤ ex" "a ≤ et' ⟹ a ≤ et"
and halfdiv_intro: "a * 2 ≤ ex / B ⟹ a ≤ ex' / B" for a
using ‹0 < ex› ‹0 < et›
by (auto simp: ex'_def et'_def)
interpret cyl': solution_in_cylinder t0 "cball t0 et'" x0' ex' f "cball x0' ex'" B
using ‹0 < et'› ‹0 < ex'› ‹0 < et› cyl.norm_f cyl.continuous subs1 ‹cball t0 et ⊆ T›
apply unfold_locales
apply (auto simp: split_beta' dist_cancel_add1 intro!: triangle
continuous_intros cyl.norm_f order_trans[OF _ cyl.e_bounded] halfdiv_intro)
by (simp add: ex'_def et'_def dist_commute)
interpret cyl': unique_on_cylinder t0 "cball t0 et'" x0' ex' "cball x0' ex'" f B L
using cyl.lipschitz[simplified] subs subs1
by (unfold_locales)
(auto simp: triangle intro!: half_intros lipschitz_on_subset[OF _ subs2])
from cyl'.solution_usolves_ode
have "(flow t0 x0' usolves_ode f from t0) (cball t0 et') (cball x0' ex')"
apply (rule usolves_ode_solves_odeI)
subgoal
apply (rule cyl'.solves_ode_on_subset_domain[where Y=X])
subgoal
apply (rule solves_ode_on_subset[where S="existence_ivl t0 x0'" and Y=X])
subgoal by (rule flow_solves_ode[OF x0'])
subgoal
using subs2 ‹cball x0 ex ⊆ X› ‹0 < et'› ‹cball t0 et' ⊆ T›
by (intro existence_ivl_maximal_interval[OF solves_ode_on_subset[OF cyl'.solution_solves_ode]])
auto
subgoal by force
done
subgoal by (force simp: ‹x0' ∈ X› iv_defined)
subgoal using ‹0 < et'› by force
subgoal by force
subgoal by force
done
subgoal by (force simp: ‹x0' ∈ X› iv_defined cyl'.solution_iv)
done
note this subset_X
} ultimately show thesis ..
qed
lemma Picard_iterate_mem_existence_ivlI:
assumes "t ∈ T"
assumes "compact C" "x0 ∈ C" "C ⊆ X"
assumes "⋀y s. s ∈ {t0 -- t} ⟹ y t0 = x0 ⟹ y ∈ {t0--s} → C ⟹ continuous_on {t0--s} y ⟹
x0 + ivl_integral t0 s (λt. f t (y t)) ∈ C"
shows "t ∈ existence_ivl t0 x0" "⋀s. s ∈ {t0 -- t} ⟹ flow t0 x0 s ∈ C"
proof -
have "{t0 -- t} ⊆ T"
by (intro closed_segment_subset_domain iv_defined assms)
from lipschitz_on_compact[OF compact_segment ‹{t0 -- t} ⊆ T› ‹compact C› ‹C ⊆ X›]
obtain L where L: "⋀s. s ∈ {t0 -- t} ⟹ L-lipschitz_on C (f s)" by metis
interpret uc: unique_on_closed t0 "{t0 -- t}" x0 f C L
using assms closed_segment_iv_subset_domain
by unfold_locales
(auto intro!: L compact_imp_closed ‹compact C› continuous_on_f continuous_intros
simp: split_beta)
have "{t0 -- t} ⊆ existence_ivl t0 x0"
using assms closed_segment_iv_subset_domain
by (intro maximal_existence_flow[OF solves_ode_on_subset[OF uc.solution_solves_ode]])
(auto simp: )
thus "t ∈ existence_ivl t0 x0"
using assms by auto
show "flow t0 x0 s ∈ C" if "s ∈ {t0 -- t}" for s
proof -
have "flow t0 x0 s = uc.solution s" "uc.solution s ∈ C"
using solves_odeD[OF uc.solution_solves_ode] that assms
by (auto simp: closed_segment_iv_subset_domain
intro!: maximal_existence_flowI(2)[where K="{t0 -- t}"])
thus ?thesis by simp
qed
qed
lemma flow_has_vderiv_on: "(flow t0 x0 has_vderiv_on (λt. f t (flow t0 x0 t))) (existence_ivl t0 x0)"
by (rule solves_ode_vderivD[OF flow_solves_ode[OF iv_defined]])
lemmas flow_has_vderiv_on_compose[derivative_intros] =
has_vderiv_on_compose2[OF flow_has_vderiv_on, THEN has_vderiv_on_eq_rhs]
end
lemma unique_on_intersection:
assumes sols: "(x solves_ode f) U X" "(y solves_ode f) V X"
assumes iv_mem: "t0 ∈ U" "t0 ∈ V" and subs: "U ⊆ T" "V ⊆ T"
assumes ivls: "is_interval U" "is_interval V"
assumes iv: "x t0 = y t0"
assumes mem: "t ∈ U" "t ∈ V"
shows "x t = y t"
proof -
from
maximal_existence_flow(2)[OF sols(1) refl ivls(1) iv_mem(1) subs(1) mem(1)]
maximal_existence_flow(2)[OF sols(2) iv[symmetric] ivls(2) iv_mem(2) subs(2) mem(2)]
show ?thesis by simp
qed
lemma unique_solution:
assumes sols: "(x solves_ode f) U X" "(y solves_ode f) U X"
assumes iv_mem: "t0 ∈ U" and subs: "U ⊆ T"
assumes ivls: "is_interval U"
assumes iv: "x t0 = y t0"
assumes mem: "t ∈ U"
shows "x t = y t"
by (metis unique_on_intersection assms)
lemma
assumes s: "s ∈ existence_ivl t0 x0"
assumes t: "t + s ∈ existence_ivl s (flow t0 x0 s)"
shows flow_trans: "flow t0 x0 (s + t) = flow s (flow t0 x0 s) (s + t)"
and existence_ivl_trans: "s + t ∈ existence_ivl t0 x0"
proof -
note ll_on_open_it_axioms
moreover
from ll_on_open_it_axioms
have iv_defined: "t0 ∈ T" "x0 ∈ X"
and iv_defined': "s ∈ T" "flow t0 x0 s ∈ X"
using ll_on_open_it.mem_existence_ivl_iv_defined s t
by blast+
have "{t0--s} ⊆ existence_ivl t0 x0"
by (simp add: s segment_subset_existence_ivl iv_defined)
have "s ∈ existence_ivl s (flow t0 x0 s)"
by (rule ll_on_open_it.existence_ivl_initial_time; fact)
have "{s--t + s} ⊆ existence_ivl s (flow t0 x0 s)"
by (rule ll_on_open_it.segment_subset_existence_ivl; fact)
have unique: "flow t0 x0 u = flow s (flow t0 x0 s) u"
if "u ∈ {s--t + s}" "u ∈ {t0--s}" for u
using
ll_on_open_it_axioms
ll_on_open_it.flow_solves_ode[OF ll_on_open_it_axioms iv_defined]
ll_on_open_it.flow_solves_ode[OF ll_on_open_it_axioms iv_defined']
s
apply (rule ll_on_open_it.unique_on_intersection)
using ‹s ∈ existence_ivl s (flow t0 x0 s)› existence_ivl_subset
‹flow t0 x0 s ∈ X› ‹s ∈ T› iv_defined s t ll_on_open_it.in_existence_between_zeroI
that ll_on_open_it_axioms ll_on_open_it.mem_existence_ivl_subset
by (auto simp: is_interval_existence_ivl)
let ?un = "{t0 -- s} ∪ {s -- t + s}"
let ?if = "λt. if t ∈ {t0 -- s} then flow t0 x0 t else flow s (flow t0 x0 s) t"
have "(?if solves_ode (λt. if t ∈ {t0 -- s} then f t else f t)) ?un (X ∪ X)"
apply (rule connection_solves_ode)
subgoal by (rule solves_ode_on_subset[OF flow_solves_ode[OF iv_defined] ‹{t0--s} ⊆ _› order_refl])
subgoal
by (rule solves_ode_on_subset[OF ll_on_open_it.flow_solves_ode[OF ll_on_open_it_axioms iv_defined']
‹{s--t + s} ⊆ _› order_refl])
subgoal by simp
subgoal by simp
subgoal by (rule unique) auto
subgoal by simp
done
then have ifsol: "(?if solves_ode f) ?un X"
by simp
moreover
have "?un ⊆ existence_ivl t0 x0"
using existence_ivl_subset[of x0]
ll_on_open_it.existence_ivl_subset[OF ll_on_open_it_axioms, of s "flow t0 x0 s"]
‹{t0 -- s} ⊆ _› ‹{s--t + s} ⊆ _›
by (intro existence_ivl_maximal_interval[OF ifsol]) (auto intro!: is_real_interval_union)
then show "s + t ∈ existence_ivl t0 x0"
by (auto simp: ac_simps)
have "(flow t0 x0 solves_ode f) ?un X"
using ‹{t0--s} ⊆ _› ‹{s -- t + s} ⊆ _›
by (intro solves_ode_on_subset[OF flow_solves_ode ‹?un ⊆ _› order_refl] iv_defined)
moreover have "s ∈ ?un"
by simp
ultimately have "?if (s + t) = flow t0 x0 (s + t)"
apply (rule ll_on_open_it.unique_solution)
using existence_ivl_subset[of x0]
ll_on_open_it.existence_ivl_subset[OF ll_on_open_it_axioms, of s "flow t0 x0 s"]
‹{t0 -- s} ⊆ _› ‹{s--t + s} ⊆ _›
by (auto intro!: is_real_interval_union simp: ac_simps)
with unique[of "s + t"]
show "flow t0 x0 (s + t) = flow s (flow t0 x0 s) (s + t)"
by (auto split: if_splits simp: ac_simps)
qed
lemma
assumes t: "t ∈ existence_ivl t0 x0"
shows flows_reverse: "flow t (flow t0 x0 t) t0 = x0"
and existence_ivl_reverse: "t0 ∈ existence_ivl t (flow t0 x0 t)"
proof -
have iv_defined: "t0 ∈ T" "x0 ∈ X"
using mem_existence_ivl_iv_defined t by blast+
show "t0 ∈ existence_ivl t (flow t0 x0 t)"
using assms
by (metis (no_types, hide_lams) closed_segment_commute closed_segment_subset_interval
ends_in_segment(2) general.csol(2-4)
general.existence_ivl_maximal_segment general.is_interval_existence_ivl
is_interval_closed_segment_1 iv_defined ll_on_open_it.equals_flowI
local.existence_ivl_initial_time local.flow_initial_time local.ll_on_open_it_axioms)
then have "flow t (flow t0 x0 t) (t + (t0 - t)) = flow t0 x0 (t + (t0 - t))"
by (intro flow_trans[symmetric]) (auto simp: t iv_defined)
then show "flow t (flow t0 x0 t) t0 = x0"
by (simp add: iv_defined)
qed
lemma flow_has_derivative:
assumes "t ∈ existence_ivl t0 x0"
shows "(flow t0 x0 has_derivative (λi. i *⇩R f t (flow t0 x0 t))) (at t)"
proof -
have "(flow t0 x0 has_derivative (λi. i *⇩R f t (flow t0 x0 t))) (at t within existence_ivl t0 x0)"
using flow_has_vderiv_on
by (auto simp: has_vderiv_on_def has_vector_derivative_def assms mem_existence_ivl_iv_defined[OF assms])
then show ?thesis
by (simp add: at_within_open[OF assms open_existence_ivl])
qed
lemma flow_has_vector_derivative:
assumes "t ∈ existence_ivl t0 x0"
shows "(flow t0 x0 has_vector_derivative f t (flow t0 x0 t)) (at t)"
using flow_has_derivative[OF assms]
by (simp add: has_vector_derivative_def)
lemma flow_has_vector_derivative_at_0:
assumes"t ∈ existence_ivl t0 x0"
shows "((λh. flow t0 x0 (t + h)) has_vector_derivative f t (flow t0 x0 t)) (at 0)"
proof -
from flow_has_vector_derivative[OF assms]
have
"((+) t has_vector_derivative 1) (at 0)"
"(flow t0 x0 has_vector_derivative f t (flow t0 x0 t)) (at (t + 0))"
by (auto intro!: derivative_eq_intros)
from vector_diff_chain_at[OF this]
show ?thesis by (simp add: o_def)
qed
lemma
assumes "t ∈ existence_ivl t0 x0"
shows closed_segment_subset_existence_ivl: "closed_segment t0 t ⊆ existence_ivl t0 x0"
and ivl_subset_existence_ivl: "{t0 .. t} ⊆ existence_ivl t0 x0"
and ivl_subset_existence_ivl': "{t .. t0} ⊆ existence_ivl t0 x0"
using assms in_existence_between_zeroI
by (auto simp: closed_segment_eq_real_ivl)
lemma flow_fixed_point:
assumes t: "t ∈ existence_ivl t0 x0"
shows "flow t0 x0 t = x0 + ivl_integral t0 t (λt. f t (flow t0 x0 t))"
proof -
have "(flow t0 x0 has_vderiv_on (λs. f s (flow t0 x0 s))) {t0 -- t}"
using closed_segment_subset_existence_ivl[OF t]
by (auto intro!: has_vector_derivative_at_within flow_has_vector_derivative
simp: has_vderiv_on_def)
from fundamental_theorem_of_calculus_ivl_integral[OF this]
have "((λt. f t (flow t0 x0 t)) has_ivl_integral flow t0 x0 t - x0) t0 t"
by (simp add: mem_existence_ivl_iv_defined[OF assms])
from this[THEN ivl_integral_unique]
show ?thesis by (simp add: )
qed
lemma flow_continuous: "t ∈ existence_ivl t0 x0 ⟹ continuous (at t) (flow t0 x0)"
by (metis has_derivative_continuous flow_has_derivative)
lemma flow_tendsto: "t ∈ existence_ivl t0 x0 ⟹ (ts ⤏ t) F ⟹
((λs. flow t0 x0 (ts s)) ⤏ flow t0 x0 t) F"
by (rule isCont_tendsto_compose[OF flow_continuous])
lemma flow_continuous_on: "continuous_on (existence_ivl t0 x0) (flow t0 x0)"
by (auto intro!: flow_continuous continuous_at_imp_continuous_on)
lemma flow_continuous_on_intro:
"continuous_on s g ⟹
(⋀xa. xa ∈ s ⟹ g xa ∈ existence_ivl t0 x0) ⟹
continuous_on s (λxa. flow t0 x0 (g xa))"
by (auto intro!: continuous_on_compose2[OF flow_continuous_on])
lemma f_flow_continuous:
assumes "t ∈ existence_ivl t0 x0"
shows "isCont (λt. f t (flow t0 x0 t)) t"
by (rule continuous_on_interior)
(insert existence_ivl_subset assms,
auto intro!: flow_in_domain flow_continuous_on continuous_intros
simp: interior_open open_existence_ivl)
lemma exponential_initial_condition:
assumes y0: "t ∈ existence_ivl t0 y0"
assumes z0: "t ∈ existence_ivl t0 z0"
assumes "Y ⊆ X"
assumes remain: "⋀s. s ∈ closed_segment t0 t ⟹ flow t0 y0 s ∈ Y"
"⋀s. s ∈ closed_segment t0 t ⟹ flow t0 z0 s ∈ Y"
assumes lipschitz: "⋀s. s ∈ closed_segment t0 t ⟹ K-lipschitz_on Y (f s)"
shows "norm (flow t0 y0 t - flow t0 z0 t) ≤ norm (y0 - z0) * exp ((K + 1) * abs (t - t0))"
proof cases
assume "y0 = z0"
thus ?thesis
by simp
next
assume ne: "y0 ≠ z0"
define K' where "K' ≡ K + 1"
from lipschitz have "K'-lipschitz_on Y (f s)" if "s ∈ {t0 -- t}" for s
using that
by (auto simp: lipschitz_on_def K'_def
intro!: order_trans[OF _ mult_right_mono[of K "K + 1"]])
from mem_existence_ivl_iv_defined[OF y0] mem_existence_ivl_iv_defined[OF z0]
have "t0 ∈ T" and inX: "y0 ∈ X" "z0 ∈ X" by auto
from remain[of t0] inX ‹t0 ∈ T › have "y0 ∈ Y" "z0 ∈ Y" by auto
define v where "v ≡ λt. norm (flow t0 y0 t - flow t0 z0 t)"
{
fix s
assume s: "s ∈ {t0 -- t}"
with s
closed_segment_subset_existence_ivl[OF y0]
closed_segment_subset_existence_ivl[OF z0]
have
y0': "s ∈ existence_ivl t0 y0" and
z0': "s ∈ existence_ivl t0 z0"
by (auto simp: closed_segment_eq_real_ivl)
have integrable:
"(λt. f t (flow t0 y0 t)) integrable_on {t0--s}"
"(λt. f t (flow t0 z0 t)) integrable_on {t0--s}"
using closed_segment_subset_existence_ivl[OF y0']
closed_segment_subset_existence_ivl[OF z0']
‹y0 ∈ X› ‹z0 ∈ X› ‹t0 ∈ T›
by (auto intro!: continuous_at_imp_continuous_on f_flow_continuous
integrable_continuous_closed_segment)
hence int: "flow t0 y0 s - flow t0 z0 s =
y0 - z0 + ivl_integral t0 s (λt. f t (flow t0 y0 t) - f t (flow t0 z0 t))"
unfolding v_def
using flow_fixed_point[OF y0'] flow_fixed_point[OF z0']
s
by (auto simp: algebra_simps ivl_integral_diff)
have "v s ≤ v t0 + K' * integral {t0 -- s} (λt. v t)"
using closed_segment_subset_existence_ivl[OF y0'] closed_segment_subset_existence_ivl[OF z0'] s
using closed_segment_closed_segment_subset[OF _ _ s, of _ t0, simplified]
by (subst integral_mult)
(auto simp: integral_mult v_def int inX ‹t0 ∈ T›
simp del: Henstock_Kurzweil_Integration.integral_mult_right
intro!: norm_triangle_le ivl_integral_norm_bound_integral
integrable_continuous_closed_segment continuous_intros
continuous_at_imp_continuous_on flow_continuous f_flow_continuous
lipschitz_on_normD[OF ‹_ ⟹ K'-lipschitz_on _ _›] remain)
} note le = this
have cont: "continuous_on {t0 -- t} v"
using closed_segment_subset_existence_ivl[OF y0] closed_segment_subset_existence_ivl[OF z0] inX
by (auto simp: v_def ‹t0 ∈ T›
intro!: continuous_at_imp_continuous_on continuous_intros flow_continuous)
have nonneg: "⋀t. v t ≥ 0"
by (auto simp: v_def)
from ne have pos: "v t0 > 0"
by (auto simp: v_def ‹t0 ∈ T› inX)
have lippos: "K' > 0"
proof -
have "0 ≤ dist (f t0 y0) (f t0 z0)" by simp
also from lipschitz_onD[OF lipschitz ‹y0 ∈ Y› ‹z0 ∈ Y›, of t0]ne
have "… ≤ K * dist y0 z0"
by simp
finally have "0 ≤ K"
by (metis dist_le_zero_iff ne zero_le_mult_iff)
thus ?thesis by (simp add: K'_def)
qed
from le cont nonneg pos ‹0 < K'›
have "v t ≤ v t0 * exp (K' * abs (t - t0))"
by (rule gronwall_general_segment) simp_all
thus ?thesis
by (simp add: v_def K'_def ‹t0 ∈ T› inX)
qed
lemma
existence_ivl_cballs:
assumes iv_defined: "t0 ∈ T" "x0 ∈ X"
obtains t u L
where
"⋀y. y ∈ cball x0 u ⟹ cball t0 t ⊆ existence_ivl t0 y"
"⋀s y. y ∈ cball x0 u ⟹ s ∈ cball t0 t ⟹ flow t0 y s ∈ cball y u"
"L-lipschitz_on (cball t0 t×cball x0 u) (λ(t, x). flow t0 x t)"
"⋀y. y ∈ cball x0 u ⟹ cball y u ⊆ X"
"0 < t" "0 < u"
proof -
note iv_defined
from local_unique_solutions[OF this]
obtain t u L where tu: "0 < t" "0 < u"
and subsT: "cball t0 t ⊆ existence_ivl t0 x0"
and subs': "cball x0 (2 * u) ⊆ X"
and lipschitz: "⋀s. s ∈ cball t0 t ⟹ L-lipschitz_on (cball x0 (2*u)) (f s)"
and usol: "⋀y. y ∈ cball x0 u ⟹ (flow t0 y usolves_ode f from t0) (cball t0 t) (cball y u)"
and subs: "⋀y. y ∈ cball x0 u ⟹ cball y u ⊆ X"
by metis
{
fix y assume y: "y ∈ cball x0 u"
from subs[OF y] ‹0 < u› have "y ∈ X" by auto
note iv' = ‹t0 ∈ T› ‹y ∈ X›
from usol[OF y, THEN usolves_odeD(1)]
have sol1: "(flow t0 y solves_ode f) (cball t0 t) (cball y u)" .
from sol1 order_refl subs[OF y]
have sol: "(flow t0 y solves_ode f) (cball t0 t) X"
by (rule solves_ode_on_subset)
note * = maximal_existence_flow[OF sol flow_initial_time
is_interval_cball_1 _ order_trans[OF subsT existence_ivl_subset],
unfolded centre_in_cball, OF iv' less_imp_le[OF ‹0 < t›]]
have eivl: "cball t0 t ⊆ existence_ivl t0 y"
by (rule *)
have "flow t0 y s ∈ cball y u" if "s ∈ cball t0 t" for s
by (rule solves_odeD(2)[OF sol1 that])
note eivl this
} note * = this
note *
moreover
have cont_on_f_flow:
"⋀x1 S. S ⊆ cball t0 t ⟹ x1 ∈ cball x0 u ⟹ continuous_on S (λt. f t (flow t0 x1 t))"
using subs[of x0] ‹u > 0› *(1) iv_defined
by (auto intro!: continuous_at_imp_continuous_on f_flow_continuous)
have "bounded ((λ(t, x). f t x) ` (cball t0 t × cball x0 (2 * u)))"
using subs' subsT existence_ivl_subset[of x0]
by (auto intro!: compact_imp_bounded compact_continuous_image compact_Times
continuous_intros simp: split_beta')
then obtain B where B: "⋀s y. s ∈ cball t0 t ⟹ y ∈ cball x0 (2 * u) ⟹ norm (f s y) ≤ B" "B > 0"
by (auto simp: bounded_pos cball_def)
have flow_in_cball: "flow t0 x1 s ∈ cball x0 (2 * u)"
if s: "s ∈ cball t0 t" and x1: "x1 ∈ cball x0 u"
for s::real and x1
proof -
from *(2)[OF x1 s] have "flow t0 x1 s ∈ cball x1 u" .
also have "… ⊆ cball x0 (2 * u)"
using x1
by (auto intro!: dist_triangle_le[OF add_mono, of _ x1 u _ u, simplified]
simp: dist_commute)
finally show ?thesis .
qed
have "(B + exp ((L + 1) * ¦t¦))-lipschitz_on (cball t0 t×cball x0 u) (λ(t, x). flow t0 x t)"
proof (rule lipschitz_onI, safe)
fix t1 t2 :: real and x1 x2
assume t1: "t1 ∈ cball t0 t" and t2: "t2 ∈ cball t0 t"
and x1: "x1 ∈ cball x0 u" and x2: "x2 ∈ cball x0 u"
have t1_ex: "t1 ∈ existence_ivl t0 x1"
and t2_ex: "t2 ∈ existence_ivl t0 x1" "t2 ∈ existence_ivl t0 x2"
and "x1 ∈ cball x0 (2*u)" "x2 ∈ cball x0 (2*u)"
using *(1)[OF x1] *(1)[OF x2] t1 t2 x1 x2 tu by auto
have "dist (flow t0 x1 t1) (flow t0 x2 t2) ≤
dist (flow t0 x1 t1) (flow t0 x1 t2) + dist (flow t0 x1 t2) (flow t0 x2 t2)"
by (rule dist_triangle)
also have "dist (flow t0 x1 t2) (flow t0 x2 t2) ≤ dist x1 x2 * exp ((L + 1) * ¦t2 - t0¦)"
unfolding dist_norm
proof (rule exponential_initial_condition[where Y = "cball x0 (2 * u)"])
fix s assume "s ∈ closed_segment t0 t2" hence s: "s ∈ cball t0 t"
using t2
by (auto simp: dist_real_def closed_segment_eq_real_ivl split: if_split_asm)
show "flow t0 x1 s ∈ cball x0 (2 * u)"
by (rule flow_in_cball[OF s x1])
show "flow t0 x2 s ∈ cball x0 (2 * u)"
by (rule flow_in_cball[OF s x2])
show "L-lipschitz_on (cball x0 (2 * u)) (f s)" if "s ∈ closed_segment t0 t2" for s
using that centre_in_cball convex_contains_segment less_imp_le t2 tu(1)
by (blast intro!: lipschitz)
qed (fact)+
also have "… ≤ dist x1 x2 * exp ((L + 1) * ¦t¦)"
using ‹u > 0› t2
by (auto
intro!: mult_left_mono add_nonneg_nonneg lipschitz[THEN lipschitz_on_nonneg]
simp: cball_eq_empty cball_eq_sing' dist_real_def)
also
have "x1 ∈ X"
using x1 subs[of x0] ‹u > 0›
by auto
have *: "¦t0 - t1¦ ≤ t ⟹ x ∈ {t0--t1} ⟹ ¦t0 - x¦ ≤ t"
"¦t0 - t2¦ ≤ t ⟹ x ∈ {t0--t2} ⟹ ¦t0 - x¦ ≤ t"
"¦t0 - t1¦ ≤ t ⟹ ¦t0 - t2¦ ≤ t ⟹ x ∈ {t1--t2} ⟹ ¦t0 - x¦ ≤ t"
for x
using t1 t2 t1_ex x1 flow_in_cball[OF _ x1]
by (auto simp: closed_segment_eq_real_ivl split: if_splits)
have integrable:
"(λt. f t (flow t0 x1 t)) integrable_on {t0--t1}"
"(λt. f t (flow t0 x1 t)) integrable_on {t0--t2}"
"(λt. f t (flow t0 x1 t)) integrable_on {t1--t2}"
using t1 t2 t1_ex x1 flow_in_cball[OF _ x1]
by (auto intro!: order_trans[OF integral_bound[where B=B]] cont_on_f_flow B
integrable_continuous_closed_segment
intro: *
simp: dist_real_def integral_minus_sets')
have *: "¦t0 - t1¦ ≤ t ⟹ ¦t0 - t2¦ ≤ t ⟹ s ∈ {t1--t2} ⟹ ¦t0 - s¦ ≤ t" for s
by (auto simp: closed_segment_eq_real_ivl split: if_splits)
note [simp] = t1_ex t2_ex ‹x1 ∈ X› integrable
have "dist (flow t0 x1 t1) (flow t0 x1 t2) ≤ dist t1 t2 * B"
using t1 t2 x1 flow_in_cball[OF _ x1] ‹t0 ∈ T›
ivl_integral_combine[of "λt. f t (flow t0 x1 t)" t2 t0 t1]
ivl_integral_combine[of "λt. f t (flow t0 x1 t)" t1 t0 t2]
by (auto simp: flow_fixed_point dist_norm add.commute closed_segment_commute
norm_minus_commute ivl_integral_minus_sets' ivl_integral_minus_sets
intro!: order_trans[OF ivl_integral_bound[where B=B]] cont_on_f_flow B dest: *)
finally
have "dist (flow t0 x1 t1) (flow t0 x2 t2) ≤
dist t1 t2 * B + dist x1 x2 * exp ((L + 1) * ¦t¦)"
by arith
also have "… ≤ dist (t1, x1) (t2, x2) * B + dist (t1, x1) (t2, x2) * exp ((L + 1) * ¦t¦)"
using ‹B > 0›
by (auto intro!: add_mono mult_right_mono simp: dist_prod_def)
finally show "dist (flow t0 x1 t1) (flow t0 x2 t2)
≤ (B + exp ((L + 1) * ¦t¦)) * dist (t1, x1) (t2, x2)"
by (simp add: algebra_simps)
qed (simp add: ‹0 < B› less_imp_le)
ultimately
show thesis using subs tu ..
qed
context
fixes x0
assumes iv_defined: "t0 ∈ T" "x0 ∈ X"
begin
lemma existence_ivl_notempty: "existence_ivl t0 x0 ≠ {}"
using existence_ivl_initial_time iv_defined
by auto
lemma initial_time_bounds:
shows "bdd_above (existence_ivl t0 x0) ⟹ t0 < Sup (existence_ivl t0 x0)" (is "?a ⟹ _")
and "bdd_below (existence_ivl t0 x0) ⟹ Inf (existence_ivl t0 x0) < t0" (is "?b ⟹ _")
proof -
from local_unique_solutions[OF iv_defined]
obtain te where te: "te > 0" "cball t0 te ⊆ existence_ivl t0 x0"
by metis
then
show "t0 < Sup (existence_ivl t0 x0)" if bdd: "bdd_above (existence_ivl t0 x0)"
using less_cSup_iff[OF existence_ivl_notempty bdd, of t0] iv_defined
by (auto simp: dist_real_def intro!: bexI[where x="t0 + te"])
from te show "Inf (existence_ivl t0 x0) < t0" if bdd: "bdd_below (existence_ivl t0 x0)"
unfolding cInf_less_iff[OF existence_ivl_notempty bdd, of t0]
by (auto simp: dist_real_def iv_defined intro!: bexI[where x="t0 - te"])
qed
lemma
flow_leaves_compact_ivl_right:
assumes bdd: "bdd_above (existence_ivl t0 x0)"
defines "b ≡ Sup (existence_ivl t0 x0)"
assumes "b ∈ T"
assumes "compact K"
assumes "K ⊆ X"
obtains t where "t ≥ t0" "t ∈ existence_ivl t0 x0" "flow t0 x0 t ∉ K"
proof (atomize_elim, rule ccontr, auto)
note iv_defined
note ne = existence_ivl_notempty
assume K[rule_format]: "∀t. t ∈ existence_ivl t0 x0 ⟶ t0 ≤ t ⟶ flow t0 x0 t ∈ K"
have b_upper: "t ≤ b" if "t ∈ existence_ivl t0 x0" for t
unfolding b_def
by (rule cSup_upper[OF that bdd])
have less_b_iff: "y < b ⟷ (∃x∈existence_ivl t0 x0. y < x)" for y
unfolding b_def less_cSup_iff[OF ne bdd] ..
have "t0 ≤ b"
by (simp add: iv_defined b_upper)
then have geI: "t ∈ {t0--<b} ⟹ t0 ≤ t" for t
by (auto simp: half_open_segment_real)
have subset: "{t0 --< b} ⊆ existence_ivl t0 x0"
using ‹t0 ≤ b› in_existence_between_zeroI
by (auto simp: half_open_segment_real iv_defined less_b_iff)
have sol: "(flow t0 x0 solves_ode f) {t0 --< b} K"
apply (rule solves_odeI)
apply (rule has_vderiv_on_subset[OF solves_odeD(1)[OF flow_solves_ode] subset])
using subset iv_defined
by (auto intro!: K geI)
have cont: "continuous_on ({t0--b} × K) (λ(t, x). f t x)"
using ‹K ⊆ X› closed_segment_subset_domainI[OF iv_defined(1) ‹b ∈ T›]
by (auto simp: split_beta intro!: continuous_intros)
from initial_time_bounds(1)[OF bdd] have "t0 ≠ b" by (simp add: b_def)
from solves_ode_half_open_segment_continuation[OF sol cont ‹compact K› ‹t0 ≠ b›]
obtain l where lim: "(flow t0 x0 ⤏ l) (at b within {t0--<b})"
and limsol: "((λt. if t = b then l else flow t0 x0 t) solves_ode f) {t0--b} K" .
have "b ∈ existence_ivl t0 x0"
using ‹t0 ≠ b› closed_segment_subset_domainI[OF ‹t0 ∈ T› ‹b ∈ T›]
by (intro existence_ivl_maximal_segment[OF solves_ode_on_subset[OF limsol order_refl ‹K ⊆ X›]])
(auto simp: iv_defined)
have "flow t0 x0 b ∈ X"
by (simp add: ‹b ∈ existence_ivl t0 x0› flow_in_domain iv_defined)
from ll_on_open_it.local_unique_solutions[OF ll_on_open_it_axioms ‹b ∈ T› ‹flow t0 x0 b ∈ X›]
obtain e where "e > 0" "cball b e ⊆ existence_ivl b (flow t0 x0 b)"
by metis
then have "e + b ∈ existence_ivl b (flow t0 x0 b)"
by (auto simp: dist_real_def)
from existence_ivl_trans[OF ‹b ∈ existence_ivl t0 x0› ‹e + b ∈ existence_ivl _ _›]
have "b + e ∈ existence_ivl t0 x0" .
from b_upper[OF this] ‹e > 0›
show False
by simp
qed
lemma
flow_leaves_compact_ivl_left:
assumes bdd: "bdd_below (existence_ivl t0 x0)"
defines "b ≡ Inf (existence_ivl t0 x0)"
assumes "b ∈ T"
assumes "compact K"
assumes "K ⊆ X"
obtains t where "t ≤ t0" "t ∈ existence_ivl t0 x0" "flow t0 x0 t ∉ K"
proof -
interpret rev: ll_on_open "(preflect t0 ` T)" "(λt. - f (preflect t0 t))" X ..
from antimono_preflect bdd have bdd_rev: "bdd_above (rev.existence_ivl t0 x0)"
unfolding rev_existence_ivl_eq
by (rule bdd_above_image_antimono)
note ne = existence_ivl_notempty
have "Sup (rev.existence_ivl t0 x0) = preflect t0 b"
using continuous_at_Inf_antimono[OF antimono_preflect _ ne bdd]
by (simp add: continuous_preflect b_def rev_existence_ivl_eq)
then have Sup_mem: "Sup (rev.existence_ivl t0 x0) ∈ preflect t0 ` T"
using ‹b ∈ T› by auto
have rev_iv: "t0 ∈ preflect t0 ` T" "x0 ∈ X" using iv_defined by auto
from rev.flow_leaves_compact_ivl_right[OF rev_iv bdd_rev Sup_mem ‹compact K› ‹K ⊆ X›]
obtain t where "t0 ≤ t" "t ∈ rev.existence_ivl t0 x0" "rev.flow t0 x0 t ∉ K" .
then have "preflect t0 t ≤ t0" "preflect t0 t ∈ existence_ivl t0 x0" "flow t0 x0 (preflect t0 t) ∉ K"
by (auto simp: rev_existence_ivl_eq rev_flow_eq)
thus ?thesis ..
qed
lemma
sup_existence_maximal:
assumes "⋀t. t0 ≤ t ⟹ t ∈ existence_ivl t0 x0 ⟹ flow t0 x0 t ∈ K"
assumes "compact K" "K ⊆ X"
assumes "bdd_above (existence_ivl t0 x0)"
shows "Sup (existence_ivl t0 x0) ∉ T"
using flow_leaves_compact_ivl_right[of K] assms by force
lemma
inf_existence_minimal:
assumes "⋀t. t ≤ t0 ⟹ t ∈ existence_ivl t0 x0 ⟹ flow t0 x0 t ∈ K"
assumes "compact K" "K ⊆ X"
assumes "bdd_below (existence_ivl t0 x0)"
shows "Inf (existence_ivl t0 x0) ∉ T"
using flow_leaves_compact_ivl_left[of K] assms
by force
end
lemma
subset_mem_compact_implies_subset_existence_interval:
assumes ivl: "t0 ∈ T'" "is_interval T'" "T' ⊆ T"
assumes iv_defined: "x0 ∈ X"
assumes mem_compact: "⋀t. t ∈ T' ⟹ t ∈ existence_ivl t0 x0 ⟹ flow t0 x0 t ∈ K"
assumes K: "compact K" "K ⊆ X"
shows "T' ⊆ existence_ivl t0 x0"
proof (rule ccontr)
assume "¬ T' ⊆ existence_ivl t0 x0"
then obtain t' where t': "t' ∉ existence_ivl t0 x0" "t' ∈ T'"
by auto
from assms have iv_defined: "t0 ∈ T" "x0 ∈ X" by auto
show False
proof (cases rule: not_in_connected_cases[OF connected_existence_ivl t'(1) existence_ivl_notempty[OF iv_defined]])
assume bdd: "bdd_below (existence_ivl t0 x0)"
assume t'_lower: "t' ≤ y" if "y ∈ existence_ivl t0 x0" for y
have i: "Inf (existence_ivl t0 x0) ∈ T'"
using initial_time_bounds[OF iv_defined] iv_defined
apply -
by (rule mem_is_intervalI[of _ t' t0])
(auto simp: ivl t' bdd intro!: t'_lower cInf_greatest[OF existence_ivl_notempty[OF iv_defined]])
have *: "t ∈ T'" if "t ≤ t0" "t ∈ existence_ivl t0 x0" for t
by (rule mem_is_intervalI[OF ‹is_interval T'› i ‹t0 ∈ T'›]) (auto intro!: cInf_lower that bdd)
from inf_existence_minimal[OF iv_defined mem_compact K bdd, OF *]
show False using i ivl by auto
next
assume bdd: "bdd_above (existence_ivl t0 x0)"
assume t'_upper: "y ≤ t'" if "y ∈ existence_ivl t0 x0" for y
have s: "Sup (existence_ivl t0 x0) ∈ T'"
using initial_time_bounds[OF iv_defined]
apply -
apply (rule mem_is_intervalI[of _ t0 t'])
by (auto simp: ivl t' bdd intro!: t'_upper cSup_least[OF existence_ivl_notempty[OF iv_defined]])
have *: "t ∈ T'" if "t0 ≤ t" "t ∈ existence_ivl t0 x0" for t
by (rule mem_is_intervalI[OF ‹is_interval T'› ‹t0 ∈ T'› s]) (auto intro!: cSup_upper that bdd)
from sup_existence_maximal[OF iv_defined mem_compact K bdd, OF *]
show False using s ivl by auto
qed
qed
lemma
mem_compact_implies_subset_existence_interval:
assumes iv_defined: "t0 ∈ T" "x0 ∈ X"
assumes mem_compact: "⋀t. t ∈ T ⟹ t ∈ existence_ivl t0 x0 ⟹ flow t0 x0 t ∈ K"
assumes K: "compact K" "K ⊆ X"
shows "T ⊆ existence_ivl t0 x0"
by (rule subset_mem_compact_implies_subset_existence_interval; (fact | rule order_refl interval iv_defined))
lemma
global_right_existence_ivl_explicit:
assumes "b ≥ t0"
assumes b: "b ∈ existence_ivl t0 x0"
obtains d K where "d > 0" "K > 0"
"ball x0 d ⊆ X"
"⋀y. y ∈ ball x0 d ⟹ b ∈ existence_ivl t0 y"
"⋀t y. y ∈ ball x0 d ⟹ t ∈ {t0 .. b} ⟹
dist (flow t0 x0 t) (flow t0 y t) ≤ dist x0 y * exp (K * abs (t - t0))"
proof -
note iv_defined = mem_existence_ivl_iv_defined[OF b]
define seg where "seg ≡ (λt. flow t0 x0 t) ` (closed_segment t0 b)"
have [simp]: "x0 ∈ seg"
by (auto simp: seg_def intro!: image_eqI[where x=t0] simp: closed_segment_eq_real_ivl iv_defined)
have "seg ≠ {}" by (auto simp: seg_def closed_segment_eq_real_ivl)
moreover
have "compact seg"
using iv_defined b
by (auto simp: seg_def closed_segment_eq_real_ivl
intro!: compact_continuous_image continuous_at_imp_continuous_on flow_continuous;
metis (erased, hide_lams) atLeastAtMost_iff closed_segment_eq_real_ivl
closed_segment_subset_existence_ivl contra_subsetD order.trans)
moreover note open_domain(2)
moreover have "seg ⊆ X"
using closed_segment_subset_existence_ivl b
by (auto simp: seg_def intro!: flow_in_domain iv_defined)
ultimately
obtain e where e: "0 < e" "{x. infdist x seg ≤ e} ⊆ X"
thm compact_in_open_separated
by (rule compact_in_open_separated)
define A where "A ≡ {x. infdist x seg ≤ e}"
have "A ⊆ X" using e by (simp add: A_def)
have mem_existence_ivlI: "⋀s. t0 ≤ s ⟹ s ≤ b ⟹ s ∈ existence_ivl t0 x0"
by (rule in_existence_between_zeroI[OF b]) (auto simp: closed_segment_eq_real_ivl)
have "compact A"
unfolding A_def
by (rule compact_infdist_le) fact+
have "compact {t0 .. b}" "{t0 .. b} ⊆ T"
subgoal by simp
subgoal
using mem_existence_ivlI mem_existence_ivl_subset[of _ x0] iv_defined b ivl_subset_existence_ivl
by blast
done
from lipschitz_on_compact[OF this ‹compact A› ‹A ⊆ X›]
obtain K' where K': "⋀t. t ∈ {t0 .. b} ⟹ K'-lipschitz_on A (f t)"
by metis
define K where "K ≡ K' + 1"
have "0 < K" "0 ≤ K"
using assms lipschitz_on_nonneg[OF K', of t0]
by (auto simp: K_def)
have K: "⋀t. t ∈ {t0 .. b} ⟹ K-lipschitz_on A (f t)"
unfolding K_def
using ‹_ ⟹ lipschitz_on K' A _›
by (rule lipschitz_on_mono) auto
have [simp]: "x0 ∈ A" using ‹0 < e› by (auto simp: A_def)
define d where "d ≡ min e (e * exp (-K * (b - t0)))"
hence d: "0 < d" "d ≤ e" "d ≤ e * exp (-K * (b - t0))"
using e by auto
have d_times_exp_le: "d * exp (K * (t - t0)) ≤ e" if "t0 ≤ t" "t ≤ b" for t
proof -
from that have "d * exp (K * (t - t0)) ≤ d * exp (K * (b - t0))"
using ‹0 ≤ K› ‹0 < d›
by (auto intro!: mult_left_mono)
also have "d * exp (K * (b - t0)) ≤ e"
using d by (auto simp: exp_minus divide_simps)
finally show ?thesis .
qed
have "ball x0 d ⊆ X" using d ‹A ⊆ X›
by (auto simp: A_def dist_commute intro!: infdist_le2[where a=x0])
note iv_defined
{
fix y
assume y: "y ∈ ball x0 d"
hence "y ∈ A" using d
by (auto simp: A_def dist_commute intro!: infdist_le2[where a=x0])
hence "y ∈ X" using ‹A ⊆ X› by auto
note y_iv = ‹t0 ∈ T› ‹y ∈ X›
have in_A: "flow t0 y t ∈ A" if t: "t0 ≤ t" "t ∈ existence_ivl t0 y" "t ≤ b" for t
proof (rule ccontr)
assume flow_out: "flow t0 y t ∉ A"
obtain t' where t':
"t0 ≤ t'"
"t' ≤ t"
"⋀t. t ∈ {t0 .. t'} ⟹ flow t0 x0 t ∈ A"
"infdist (flow t0 y t') seg ≥ e"
"⋀t. t ∈ {t0 .. t'} ⟹ flow t0 y t ∈ A"
proof -
let ?out = "((λt. infdist (flow t0 y t) seg) -` {e..}) ∩ {t0..t}"
have "compact ?out"
unfolding compact_eq_bounded_closed
proof safe
show "bounded ?out" by (auto intro!: bounded_closed_interval)
have "continuous_on {t0 .. t} ((λt. infdist (flow t0 y t) seg))"
using closed_segment_subset_existence_ivl t iv_defined
by (force intro!: continuous_at_imp_continuous_on
continuous_intros flow_continuous
simp: closed_segment_eq_real_ivl)
thus "closed ?out"
by (simp add: continuous_on_closed_vimage)
qed
moreover
have "t ∈ (λt. infdist (flow t0 y t) seg) -` {e..} ∩ {t0..t}"
using flow_out ‹t0 ≤ t›
by (auto simp: A_def)
hence "?out ≠ {}"
by blast
ultimately have "∃s∈?out. ∀t∈?out. s ≤ t"
by (rule compact_attains_inf)
then obtain t' where t':
"⋀s. e ≤ infdist (flow t0 y s) seg ⟹ t0 ≤ s ⟹ s ≤ t ⟹ t' ≤ s"
"e ≤ infdist (flow t0 y t') seg"
"t0 ≤ t'" "t' ≤ t"
by (auto simp: vimage_def Ball_def) metis
have flow_in: "flow t0 x0 s ∈ A" if s: "s ∈ {t0 .. t'}" for s
proof -
from s have "s ∈ closed_segment t0 b"
using ‹t ≤ b› t' by (auto simp: closed_segment_eq_real_ivl)
then show ?thesis
using s ‹e > 0› by (auto simp: seg_def A_def)
qed
have "flow t0 y t' ∈ A" if "t' = t0"
using y d iv_defined that
by (auto simp: A_def ‹y ∈ X› infdist_le2[where a=x0] dist_commute)
moreover
have "flow t0 y s ∈ A" if s: "s ∈ {t0 ..< t'}" for s
proof -
from s have "s ∈ closed_segment t0 b"
using ‹t ≤ b› t' by (auto simp: closed_segment_eq_real_ivl)
from t'(1)[of s]
have "t' > s ⟹ t0 ≤ s ⟹ s ≤ t ⟹ e > infdist (flow t0 y s) seg"
by force
then show ?thesis
using s t' ‹e > 0› by (auto simp: seg_def A_def)
qed
moreover
note left_of_in = this
have "closed A" using ‹compact A› by (auto simp: compact_eq_bounded_closed)
have "((λs. flow t0 y s) ⤏ flow t0 y t') (at_left t')"
using closed_segment_subset_existence_ivl[OF t(2)] t' ‹y ∈ X› iv_defined
by (intro flow_tendsto) (auto intro!: tendsto_intros simp: closed_segment_eq_real_ivl)
with ‹closed A› _ _ have "t' ≠ t0 ⟹ flow t0 y t' ∈ A"
proof (rule Lim_in_closed_set)
assume "t' ≠ t0"
hence "t' > t0" using t' by auto
hence "eventually (λx. x ≥ t0) (at_left t')"
by (metis eventually_at_left less_imp_le)
thus "eventually (λx. flow t0 y x ∈ A) (at_left t')"
unfolding eventually_at_filter
by eventually_elim (auto intro!: left_of_in)
qed simp
ultimately have flow_y_in: "s ∈ {t0 .. t'} ⟹ flow t0 y s ∈ A" for s
by (cases "s = t'"; fastforce)
have
"t0 ≤ t'"
"t' ≤ t"
"⋀t. t ∈ {t0 .. t'} ⟹ flow t0 x0 t ∈ A"
"infdist (flow t0 y t') seg ≥ e"
"⋀t. t ∈ {t0 .. t'} ⟹ flow t0 y t ∈ A"
by (auto intro!: flow_in flow_y_in) fact+
thus ?thesis ..
qed
{
fix s assume s: "s ∈ {t0 .. t'}"
hence "t0 ≤ s" by simp
have "s ≤ b"
using t t' s b
by auto
hence sx0: "s ∈ existence_ivl t0 x0"
by (simp add: ‹t0 ≤ s› mem_existence_ivlI)
have sy: "s ∈ existence_ivl t0 y"
by (meson atLeastAtMost_iff contra_subsetD s t'(1) t'(2) that(2) ivl_subset_existence_ivl)
have int: "flow t0 y s - flow t0 x0 s =
y - x0 + (integral {t0 .. s} (λt. f t (flow t0 y t)) -
integral {t0 .. s} (λt. f t (flow t0 x0 t)))"
using iv_defined s
unfolding flow_fixed_point[OF sx0] flow_fixed_point[OF sy]
by (simp add: algebra_simps ivl_integral_def)
have "norm (flow t0 y s - flow t0 x0 s) ≤ norm (y - x0) +
norm (integral {t0 .. s} (λt. f t (flow t0 y t)) -
integral {t0 .. s} (λt. f t (flow t0 x0 t)))"
unfolding int
by (rule norm_triangle_ineq)
also
have "norm (integral {t0 .. s} (λt. f t (flow t0 y t)) -
integral {t0 .. s} (λt. f t (flow t0 x0 t))) =
norm (integral {t0 .. s} (λt. f t (flow t0 y t) - f t (flow t0 x0 t)))"
using closed_segment_subset_existence_ivl[of s x0] sx0 closed_segment_subset_existence_ivl[of s y] sy
by (subst Henstock_Kurzweil_Integration.integral_diff)
(auto intro!: integrable_continuous_real continuous_at_imp_continuous_on
f_flow_continuous
simp: closed_segment_eq_real_ivl)
also have "… ≤ (integral {t0 .. s} (λt. norm (f t (flow t0 y t) - f t (flow t0 x0 t))))"
using closed_segment_subset_existence_ivl[of s x0] sx0 closed_segment_subset_existence_ivl[of s y] sy
by (intro integral_norm_bound_integral)
(auto intro!: integrable_continuous_real continuous_at_imp_continuous_on
f_flow_continuous continuous_intros
simp: closed_segment_eq_real_ivl)
also have "… ≤ (integral {t0 .. s} (λt. K * norm ((flow t0 y t) - (flow t0 x0 t))))"
using closed_segment_subset_existence_ivl[of s x0] sx0 closed_segment_subset_existence_ivl[of s y] sy
iv_defined s t'(3,5) ‹s ≤ b›
by (auto simp del: Henstock_Kurzweil_Integration.integral_mult_right intro!: integral_le integrable_continuous_real
continuous_at_imp_continuous_on lipschitz_on_normD[OF K]
flow_continuous f_flow_continuous continuous_intros
simp: closed_segment_eq_real_ivl)
also have "… = K * integral {t0 .. s} (λt. norm (flow t0 y t - flow t0 x0 t))"
using closed_segment_subset_existence_ivl[of s x0] sx0 closed_segment_subset_existence_ivl[of s y] sy
by (subst integral_mult)
(auto intro!: integrable_continuous_real continuous_at_imp_continuous_on
lipschitz_on_normD[OF K] flow_continuous f_flow_continuous continuous_intros
simp: closed_segment_eq_real_ivl)
finally
have norm: "norm (flow t0 y s - flow t0 x0 s) ≤
norm (y - x0) + K * integral {t0 .. s} (λt. norm (flow t0 y t - flow t0 x0 t))"
by arith
note norm ‹s ≤ b› sx0 sy
} note norm_le = this
from norm_le(2) t' have "t' ∈ closed_segment t0 b"
by (auto simp: closed_segment_eq_real_ivl)
hence "infdist (flow t0 y t') seg ≤ dist (flow t0 y t') (flow t0 x0 t')"
by (auto simp: seg_def infdist_le)
also have "… ≤ norm (flow t0 y t' - flow t0 x0 t')"
by (simp add: dist_norm)
also have "… ≤ norm (y - x0) * exp (K * ¦t' - t0¦)"
unfolding K_def
apply (rule exponential_initial_condition[OF _ _ _ _ _ K'])
subgoal by (metis atLeastAtMost_iff local.norm_le(4) order_refl t'(1))
subgoal by (metis atLeastAtMost_iff local.norm_le(3) order_refl t'(1))
subgoal using e by (simp add: A_def)
subgoal by (metis closed_segment_eq_real_ivl t'(1,5))
subgoal by (metis closed_segment_eq_real_ivl t'(1,3))
subgoal by (simp add: closed_segment_eq_real_ivl local.norm_le(2) t'(1))
done
also have "… < d * exp (K * (t - t0))"
using y d t' t
by (intro mult_less_le_imp_less)
(auto simp: dist_norm[symmetric] dist_commute intro!: mult_mono ‹0 ≤ K›)
also have "… ≤ e"
by (rule d_times_exp_le; fact)
finally
have "infdist (flow t0 y t') seg < e" .
with ‹infdist (flow t0 y t') seg ≥ e› show False
by (auto simp: frontier_def)
qed
have "{t0..b} ⊆ existence_ivl t0 y"
by (rule subset_mem_compact_implies_subset_existence_interval[OF
_ is_interval_cc ‹{t0..b} ⊆ T› ‹y ∈ X› in_A ‹compact A› ‹A ⊆ X›])
(auto simp: ‹t0 ≤ b›)
with ‹t0 ≤ b› have b_in: "b ∈ existence_ivl t0 y"
by force
{
fix t assume t: "t ∈ {t0 .. b}"
also have "{t0 .. b} = {t0 -- b}"
by (auto simp: closed_segment_eq_real_ivl assms)
also note closed_segment_subset_existence_ivl[OF b_in]
finally have t_in: "t ∈ existence_ivl t0 y" .
note t
also note ‹{t0 .. b} = {t0 -- b}›
also note closed_segment_subset_existence_ivl[OF assms(2)]
finally have t_in': "t ∈ existence_ivl t0 x0" .
have "norm (flow t0 y t - flow t0 x0 t) ≤ norm (y - x0) * exp (K * ¦t - t0¦)"
unfolding K_def
using t closed_segment_subset_existence_ivl[OF b_in] ‹0 < e›
by (intro in_A exponential_initial_condition[OF t_in t_in' ‹A ⊆ X› _ _ K'])
(auto simp: closed_segment_eq_real_ivl A_def seg_def)
hence "dist (flow t0 x0 t) (flow t0 y t) ≤ dist x0 y * exp (K * ¦t - t0¦)"
by (auto simp: dist_norm[symmetric] dist_commute)
}
note b_in this
} from ‹d > 0› ‹K > 0› ‹ball x0 d ⊆ X› this show ?thesis ..
qed
lemma
global_left_existence_ivl_explicit:
assumes "b ≤ t0"
assumes b: "b ∈ existence_ivl t0 x0"
assumes iv_defined: "t0 ∈ T" "x0 ∈ X"
obtains d K where "d > 0" "K > 0"
"ball x0 d ⊆ X"
"⋀y. y ∈ ball x0 d ⟹ b ∈ existence_ivl t0 y"
"⋀t y. y ∈ ball x0 d ⟹ t ∈ {b .. t0} ⟹ dist (flow t0 x0 t) (flow t0 y t) ≤ dist x0 y * exp (K * abs (t - t0))"
proof -
interpret rev: ll_on_open "(preflect t0 ` T)" "(λt. - f (preflect t0 t))" X ..
have t0': "t0 ∈ preflect t0 ` T" "x0 ∈ X"
by (auto intro!: iv_defined)
from assms have "preflect t0 b ≥ t0" "preflect t0 b ∈ rev.existence_ivl t0 x0"
by (auto simp: rev_existence_ivl_eq)
from rev.global_right_existence_ivl_explicit[OF this]
obtain d K where dK: "d > 0" "K > 0"
"ball x0 d ⊆ X"
"⋀y. y ∈ ball x0 d ⟹ preflect t0 b ∈ rev.existence_ivl t0 y"
"⋀t y. y ∈ ball x0 d ⟹ t ∈ {t0 .. preflect t0 b} ⟹ dist (rev.flow t0 x0 t) (rev.flow t0 y t) ≤ dist x0 y * exp (K * abs (t - t0))"
by (auto simp: rev_flow_eq ‹x0 ∈ X›)
have ex_ivlI: "dist x0 y < d ⟹ t ∈ existence_ivl t0 y" if "b ≤ t" "t ≤ t0" for t y
using that dK(4)[of y] dK(3) iv_defined
by (auto simp: subset_iff rev_existence_ivl_eq[of ]
closed_segment_eq_real_ivl iv_defined in_existence_between_zeroI)
have "b ∈ existence_ivl t0 y" if "dist x0 y < d" for y
using that dK
by (subst existence_ivl_eq_rev) (auto simp: iv_defined intro!: image_eqI[where x="preflect t0 b"])
with dK have "d > 0" "K > 0"
"ball x0 d ⊆ X"
"⋀y. y ∈ ball x0 d ⟹ b ∈ existence_ivl t0 y"
"⋀t y. y ∈ ball x0 d ⟹ t ∈ {b .. t0} ⟹ dist (flow t0 x0 t) (flow t0 y t) ≤ dist x0 y * exp (K * abs (t - t0))"
by (auto simp: flow_eq_rev iv_defined ex_ivlI ‹x0 ∈ X› subset_iff
intro!: order_trans[OF dK(5)] image_eqI[where x="preflect t0 b"])
then show ?thesis ..
qed
lemma
global_existence_ivl_explicit:
assumes a: "a ∈ existence_ivl t0 x0"
assumes b: "b ∈ existence_ivl t0 x0"
assumes le: "a ≤ b"
obtains d K where "d > 0" "K > 0"
"ball x0 d ⊆ X"
"⋀y. y ∈ ball x0 d ⟹ a ∈ existence_ivl t0 y"
"⋀y. y ∈ ball x0 d ⟹ b ∈ existence_ivl t0 y"
"⋀t y. y ∈ ball x0 d ⟹ t ∈ {a .. b} ⟹
dist (flow t0 x0 t) (flow t0 y t) ≤ dist x0 y * exp (K * abs (t - t0))"
proof -
note iv_defined = mem_existence_ivl_iv_defined[OF a]
define r where "r ≡ Max {t0, a, b}"
define l where "l ≡ Min {t0, a, b}"
have r: "r ≥ t0" "r ∈ existence_ivl t0 x0"
using a b by (auto simp: max_def r_def iv_defined)
obtain dr Kr where right:
"0 < dr" "0 < Kr" "ball x0 dr ⊆ X"
"⋀y. y ∈ ball x0 dr ⟹ r ∈ existence_ivl t0 y"
"⋀y t. y ∈ ball x0 dr ⟹ t ∈ {t0..r} ⟹ dist (flow t0 x0 t) (flow t0 y t) ≤ dist x0 y * exp (Kr * ¦t - t0¦)"
by (rule global_right_existence_ivl_explicit[OF r]) blast
have l: "l ≤ t0" "l ∈ existence_ivl t0 x0"
using a b by (auto simp: min_def l_def iv_defined)
obtain dl Kl where left:
"0 < dl" "0 < Kl" "ball x0 dl ⊆ X"
"⋀y. y ∈ ball x0 dl ⟹ l ∈ existence_ivl t0 y"
"⋀y t. y ∈ ball x0 dl ⟹ t ∈ {l .. t0} ⟹ dist (flow t0 x0 t) (flow t0 y t) ≤ dist x0 y * exp (Kl * ¦t - t0¦)"
by (rule global_left_existence_ivl_explicit[OF l iv_defined]) blast
define d where "d ≡ min dr dl"
define K where "K ≡ max Kr Kl"
note iv_defined
have "0 < d" "0 < K" "ball x0 d ⊆ X"
using left right by (auto simp: d_def K_def)
moreover
{
fix y assume y: "y ∈ ball x0 d"
hence "y ∈ X" using ‹ball x0 d ⊆ X› by auto
from y
closed_segment_subset_existence_ivl[OF left(4), of y]
closed_segment_subset_existence_ivl[OF right(4), of y]
have "a ∈ existence_ivl t0 y" "b ∈ existence_ivl t0 y"
by (auto simp: d_def l_def r_def min_def max_def closed_segment_eq_real_ivl split: if_split_asm)
}
moreover
{
fix t y
assume y: "y ∈ ball x0 d"
and t: "t ∈ {a .. b}"
from y have "y ∈ X" using ‹ball x0 d ⊆ X› by auto
have "dist (flow t0 x0 t) (flow t0 y t) ≤ dist x0 y * exp (K * abs (t - t0))"
proof cases
assume "t ≥ t0"
hence "dist (flow t0 x0 t) (flow t0 y t) ≤ dist x0 y * exp (Kr * abs (t - t0))"
using y t
by (intro right) (auto simp: d_def r_def)
also have "exp (Kr * abs (t - t0)) ≤ exp (K * abs (t - t0))"
by (auto simp: mult_left_mono K_def max_def mult_right_mono)
finally show ?thesis by (simp add: mult_left_mono)
next
assume "¬t ≥ t0"
hence "dist (flow t0 x0 t) (flow t0 y t) ≤ dist x0 y * exp (Kl * abs (t - t0))"
using y t
by (intro left) (auto simp: d_def l_def)
also have "exp (Kl * abs (t - t0)) ≤ exp (K * abs (t - t0))"
by (auto simp: mult_left_mono K_def max_def mult_right_mono)
finally show ?thesis by (simp add: mult_left_mono)
qed
} ultimately show ?thesis ..
qed
lemma eventually_exponential_separation:
assumes a: "a ∈ existence_ivl t0 x0"
assumes b: "b ∈ existence_ivl t0 x0"
assumes le: "a ≤ b"
obtains K where "K > 0" "∀⇩F y in at x0. ∀t∈{a..b}. dist (flow t0 x0 t) (flow t0 y t) ≤ dist x0 y * exp (K * ¦t - t0¦)"
proof -
from global_existence_ivl_explicit[OF assms]
obtain d K where *: "d > 0" "K > 0"
"ball x0 d ⊆ X"
"⋀y. y ∈ ball x0 d ⟹ a ∈ existence_ivl t0 y"
"⋀y. y ∈ ball x0 d ⟹ b ∈ existence_ivl t0 y"
"⋀t y. y ∈ ball x0 d ⟹ t ∈ {a .. b} ⟹
dist (flow t0 x0 t) (flow t0 y t) ≤ dist x0 y * exp (K * abs (t - t0))"
by auto
note ‹K > 0›
moreover
have "eventually (λy. y ∈ ball x0 d) (at x0)"
using ‹d > 0›[THEN eventually_at_ball]
by eventually_elim simp
hence "eventually (λy. ∀t∈{a..b}. dist (flow t0 x0 t) (flow t0 y t) ≤ dist x0 y * exp (K * ¦t - t0¦)) (at x0)"
by eventually_elim (safe intro!: *)
ultimately show ?thesis ..
qed
lemma eventually_mem_existence_ivl:
assumes b: "b ∈ existence_ivl t0 x0"
shows "∀⇩F x in at x0. b ∈ existence_ivl t0 x"
proof -
from mem_existence_ivl_iv_defined[OF b] have iv_defined: "t0 ∈ T" "x0 ∈ X" by simp_all
note eiit = existence_ivl_initial_time[OF iv_defined]
{
fix a b
assume assms: "a ∈ existence_ivl t0 x0" "b ∈ existence_ivl t0 x0" "a ≤ b"
from global_existence_ivl_explicit[OF assms]
obtain d K where *: "d > 0" "K > 0"
"ball x0 d ⊆ X"
"⋀y. y ∈ ball x0 d ⟹ a ∈ existence_ivl t0 y"
"⋀y. y ∈ ball x0 d ⟹ b ∈ existence_ivl t0 y"
"⋀t y. y ∈ ball x0 d ⟹ t ∈ {a .. b} ⟹
dist (flow t0 x0 t) (flow t0 y t) ≤ dist x0 y * exp (K * abs (t - t0))"
by auto
have "eventually (λy. y ∈ ball x0 d) (at x0)"
using ‹d > 0›[THEN eventually_at_ball]
by eventually_elim simp
then have "∀⇩F x in at x0. a ∈ existence_ivl t0 x ∧ b ∈ existence_ivl t0 x"
by (eventually_elim) (auto intro!: *)
} from this[OF b eiit] this[OF eiit b]
show ?thesis
by (cases "t0 ≤ b") (auto simp: eventually_mono)
qed
lemma uniform_limit_flow:
assumes a: "a ∈ existence_ivl t0 x0"
assumes b: "b ∈ existence_ivl t0 x0"
assumes le: "a ≤ b"
shows "uniform_limit {a .. b} (flow t0) (flow t0 x0) (at x0)"
proof (rule uniform_limitI)
fix e::real assume "0 < e"
from eventually_exponential_separation[OF assms] obtain K where "0 < K"
"∀⇩F y in at x0. ∀t∈{a..b}. dist (flow t0 x0 t) (flow t0 y t) ≤ dist x0 y * exp (K * ¦t - t0¦)"
by auto
note this(2)
moreover
let ?m = "max (abs (b - t0)) (abs (a - t0))"
have "eventually (λy. ∀t∈{a..b}. dist x0 y * exp (K * ¦t - t0¦) ≤ dist x0 y * exp (K * ?m)) (at x0)"
using ‹a ≤ b› ‹0 < K›
by (auto intro!: mult_left_mono always_eventually)
moreover
have "eventually (λy. dist x0 y * exp (K * ?m) < e) (at x0)"
using ‹0 < e› by (auto intro!: order_tendstoD tendsto_eq_intros)
ultimately
show "eventually (λy. ∀t∈{a..b}. dist (flow t0 y t) (flow t0 x0 t) < e) (at x0)"
by eventually_elim (force simp: dist_commute)
qed
lemma eventually_at_fst:
assumes "eventually P (at (fst x))"
assumes "P (fst x)"
shows "eventually (λh. P (fst h)) (at x)"
using assms
unfolding eventually_at_topological
by (metis open_vimage_fst rangeI range_fst vimageE vimageI)
lemma eventually_at_snd:
assumes "eventually P (at (snd x))"
assumes "P (snd x)"
shows "eventually (λh. P (snd h)) (at x)"
using assms
unfolding eventually_at_topological
by (metis open_vimage_snd rangeI range_snd vimageE vimageI)
lemma
shows open_state_space: "open (Sigma X (existence_ivl t0))"
and flow_continuous_on_state_space:
"continuous_on (Sigma X (existence_ivl t0)) (λ(x, t). flow t0 x t)"
proof (safe intro!: topological_space_class.openI continuous_at_imp_continuous_on)
fix t x assume "x ∈ X" and t: "t ∈ existence_ivl t0 x"
have iv_defined: "t0 ∈ T" "x ∈ X"
using mem_existence_ivl_iv_defined[OF t] by auto
from ‹x ∈ X› t open_existence_ivl
obtain e where e: "e > 0" "cball t e ⊆ existence_ivl t0 x"
by (metis open_contains_cball)
hence ivl: "t - e ∈ existence_ivl t0 x" "t + e ∈ existence_ivl t0 x" "t - e ≤ t + e"
by (auto simp: cball_def dist_real_def)
obtain d K where dK:
"0 < d" "0 < K" "ball x d ⊆ X"
"⋀y. y ∈ ball x d ⟹ t - e ∈ existence_ivl t0 y"
"⋀y. y ∈ ball x d ⟹ t + e ∈ existence_ivl t0 y"
"⋀y s. y ∈ ball x d ⟹ s ∈ {t - e..t + e} ⟹
dist (flow t0 x s) (flow t0 y s) ≤ dist x y * exp (K * ¦s - t0¦)"
by (rule global_existence_ivl_explicit[OF ivl]) blast
let ?T = "ball x d × ball t e"
have "open ?T" by (auto intro!: open_Times)
moreover have "(x, t) ∈ ?T" by (auto simp: dK ‹0 < e›)
moreover have "?T ⊆ Sigma X (existence_ivl t0)"
proof safe
fix s y assume y: "y ∈ ball x d" and s: "s ∈ ball t e"
with ‹ball x d ⊆ X› show "y ∈ X" by auto
have "ball t e ⊆ closed_segment t0 (t - e) ∪ closed_segment t0 (t + e)"
by (auto simp: closed_segment_eq_real_ivl dist_real_def)
with ‹y ∈ X› s closed_segment_subset_existence_ivl[OF dK(4)[OF y]]
closed_segment_subset_existence_ivl[OF dK(5)[OF y]]
show "s ∈ existence_ivl t0 y"
by auto
qed
ultimately show "∃T. open T ∧ (x, t) ∈ T ∧ T ⊆ Sigma X (existence_ivl t0)"
by blast
have **: "∀⇩F s in at 0. norm (flow t0 (x + fst s) (t + snd s) - flow t0 x t) < 2 * eps"
if "eps > 0" for eps :: real
proof -
have "∀⇩F s in at 0. norm (flow t0 (x + fst s) (t + snd s) - flow t0 x t) =
norm (flow t0 (x + fst s) (t + snd s) - flow t0 x (t + snd s) +
(flow t0 x (t + snd s) - flow t0 x t))"
by auto
moreover
have "∀⇩F s in at 0.
norm (flow t0 (x + fst s) (t + snd s) - flow t0 x (t + snd s) +
(flow t0 x (t + snd s) - flow t0 x t)) ≤
norm (flow t0 (x + fst s) (t + snd s) - flow t0 x (t + snd s)) +
norm (flow t0 x (t + snd s) - flow t0 x t)"
by eventually_elim (rule norm_triangle_ineq)
moreover
have "∀⇩F s in at 0. t + snd s ∈ ball t e"
by (auto simp: dist_real_def intro!: order_tendstoD[OF _ ‹0 < e›]
intro!: tendsto_eq_intros)
moreover from uniform_limit_flow[OF ivl, THEN uniform_limitD, OF ‹eps > 0›]
have "∀⇩F (h::(_ )) in at (fst (0::'a*real)).
∀t∈{t - e..t + e}. dist (flow t0 x t) (flow t0 (x + h) t) < eps"
by (subst (asm) at_to_0)
(auto simp: eventually_filtermap dist_commute ac_simps)
hence "∀⇩F (h::(_ * real)) in at 0.
∀t∈{t - e..t + e}. dist (flow t0 x t) (flow t0 (x + fst h) t) < eps"
by (rule eventually_at_fst) (simp add: ‹eps > 0›)
moreover
have "∀⇩F h in at (snd (0::'a * _)). norm (flow t0 x (t + h) - flow t0 x t) < eps"
using flow_continuous[OF t, unfolded isCont_def, THEN tendstoD, OF ‹eps > 0›]
by (subst (asm) at_to_0)
(auto simp: eventually_filtermap dist_norm ac_simps)
hence "∀⇩F h::('a * _) in at 0. norm (flow t0 x (t + snd h) - flow t0 x t) < eps"
by (rule eventually_at_snd) (simp add: ‹eps > 0›)
ultimately
show ?thesis
proof eventually_elim
case (elim s)
note elim(1)
also note elim(2)
also note elim(5)
also
from elim(3) have "t + snd s ∈ {t - e..t + e}"
by (auto simp: dist_real_def algebra_simps)
from elim(4)[rule_format, OF this]
have "norm (flow t0 (x + fst s) (t + snd s) - flow t0 x (t + snd s)) < eps"
by (auto simp: dist_commute dist_norm[symmetric])
finally
show ?case by simp
qed
qed
have *: "∀⇩F s in at 0. norm (flow t0 (x + fst s) (t + snd s) - flow t0 x t) < eps"
if "eps > 0" for eps::real
proof -
from that have "eps / 2 > 0" by simp
from **[OF this] show ?thesis by auto
qed
show "isCont (λ(x, y). flow t0 x y) (x, t)"
unfolding isCont_iff
by (rule LIM_zero_cancel)
(auto simp: split_beta' norm_conv_dist[symmetric] intro!: tendstoI *)
qed
lemmas flow_continuous_on_compose[continuous_intros] =
continuous_on_compose_Pair[OF flow_continuous_on_state_space]
lemma flow_isCont_state_space: "t ∈ existence_ivl t0 x0 ⟹ isCont (λ(x, t). flow t0 x t) (x0, t)"
using flow_continuous_on_state_space[of] mem_existence_ivl_iv_defined[of t x0]
using continuous_on_eq_continuous_at open_state_space by fastforce
lemma
flow_absolutely_integrable_on[integrable_on_simps]:
assumes "s ∈ existence_ivl t0 x0"
shows "(λx. norm (flow t0 x0 x)) integrable_on closed_segment t0 s"
using assms
by (auto simp: closed_segment_eq_real_ivl intro!: integrable_continuous_real continuous_intros
flow_continuous_on_intro
intro: in_existence_between_zeroI)
lemma existence_ivl_eq_domain:
assumes iv_defined: "t0 ∈ T" "x0 ∈ X"
assumes bnd: "⋀tm tM t x. tm ∈ T ⟹ tM ∈ T ⟹ ∃M. ∃L. ∀t ∈ {tm .. tM}. ∀x ∈ X. norm (f t x) ≤ M + L * norm x"
assumes "is_interval T" "X = UNIV"
shows "existence_ivl t0 x0 = T"
proof -
from assms have XI: "x ∈ X" for x by auto
{
fix tm tM assume tm: "tm ∈ T" and tM: "tM ∈ T" and tmtM: "tm ≤ t0" "t0 ≤ tM"
from bnd[OF tm tM] obtain M' L'
where bnd': "⋀x t. x ∈ X ⟹ tm ≤ t ⟹ t ≤ tM ⟹ norm (f t x) ≤ M' + L' * norm x"
by force
define M where "M ≡ norm M' + 1"
define L where "L ≡ norm L' + 1"
have bnd: "⋀x t. x ∈ X ⟹ tm ≤ t ⟹ t ≤ tM ⟹ norm (f t x) ≤ M + L * norm x"
by (auto simp: M_def L_def intro!: bnd'[THEN order_trans] add_mono mult_mono)
have "M > 0" "L > 0" by (auto simp: L_def M_def)
let ?r = "(norm x0 + ¦tm - tM¦ * M + 1) * exp (L * ¦tm - tM¦)"
define K where "K ≡ cball (0::'a) ?r"
have K: "compact K" "K ⊆ X"
by (auto simp: K_def ‹X = UNIV›)
{
fix t assume t: "t ∈ existence_ivl t0 x0" and le: "tm ≤ t" "t ≤ tM"
{
fix s assume sc: "s ∈ closed_segment t0 t"
then have s: "s ∈ existence_ivl t0 x0" and le: "tm ≤ s" "s ≤ tM" using t le sc
using closed_segment_subset_existence_ivl
apply -
subgoal by force
subgoal by (metis (full_types) atLeastAtMost_iff closed_segment_eq_real_ivl order_trans tmtM(1))
subgoal by (metis (full_types) atLeastAtMost_iff closed_segment_eq_real_ivl order_trans tmtM(2))
done
from sc have nle: "norm (t0 - s) ≤ norm (t0 - t)" by (auto simp: closed_segment_eq_real_ivl split: if_split_asm)
from flow_fixed_point[OF s]
have "norm (flow t0 x0 s) ≤ norm x0 + integral (closed_segment t0 s) (λt. M + L * norm (flow t0 x0 t))"
using tmtM
using closed_segment_subset_existence_ivl[OF s] le
by (auto simp:
intro!: norm_triangle_le norm_triangle_ineq4[THEN order.trans]
ivl_integral_norm_bound_integral bnd
integrable_continuous_closed_segment
integrable_continuous_real
continuous_intros
continuous_on_subset[OF flow_continuous_on]
flow_in_domain
mem_existence_ivl_subset)
(auto simp: closed_segment_eq_real_ivl split: if_splits)
also have "… = norm x0 + norm (t0 - s) * M + L * integral (closed_segment t0 s) (λt. norm (flow t0 x0 t))"
by (simp add: integral_add integrable_on_simps ‹s ∈ existence_ivl _ _›
integral_const_closed_segment abs_minus_commute)
also have "norm (t0 - s) * M ≤ norm (t0 - t) * M "
using nle ‹M > 0› by auto
also have "… ≤ … + 1" by simp
finally have "norm (flow t0 x0 s) ≤ norm x0 + norm (t0 - t) * M + 1 +
L * integral (closed_segment t0 s) (λt. norm (flow t0 x0 t))" by simp
}
then have "norm (flow t0 x0 t) ≤ (norm x0 + norm (t0 - t) * M + 1) * exp (L * ¦t - t0¦)"
using closed_segment_subset_existence_ivl[OF t]
by (intro gronwall_more_general_segment[where a=t0 and b = t and t = t])
(auto simp: ‹0 < L› ‹0 < M› less_imp_le
intro!: add_nonneg_pos mult_nonneg_nonneg add_nonneg_nonneg continuous_intros
flow_continuous_on_intro)
also have "… ≤ ?r"
using le tmtM
by (auto simp: less_imp_le ‹0 < M› ‹0 < L› abs_minus_commute intro!: mult_mono)
finally
have "flow t0 x0 t ∈ K" by (simp add: dist_norm K_def)
} note flow_compact = this
have "{tm..tM} ⊆ existence_ivl t0 x0"
using tmtM tm ‹x0 ∈ X› ‹compact K› ‹K ⊆ X› mem_is_intervalI[OF ‹is_interval T› ‹tm ∈ T› ‹tM ∈ T›]
by (intro subset_mem_compact_implies_subset_existence_interval[OF _ _ _ _flow_compact])
(auto simp: tmtM is_interval_cc)
} note bnds = this
show "existence_ivl t0 x0 = T"
proof safe
fix x assume x: "x ∈ T"
from bnds[OF x iv_defined(1)] bnds[OF iv_defined(1) x]
show "x ∈ existence_ivl t0 x0"
by (cases "x ≤ t0") auto
qed (insert existence_ivl_subset, fastforce)
qed
lemma flow_unique:
assumes "t ∈ existence_ivl t0 x0"
assumes "phi t0 = x0"
assumes "⋀t. t ∈ existence_ivl t0 x0 ⟹ (phi has_vector_derivative f t (phi t)) (at t)"
assumes "⋀t. t ∈ existence_ivl t0 x0 ⟹ phi t ∈ X"
shows "flow t0 x0 t = phi t"
apply (rule maximal_existence_flow[where K="existence_ivl t0 x0"])
subgoal by (auto intro!: solves_odeI simp: has_vderiv_on_def assms at_within_open[OF _ open_existence_ivl])
subgoal by fact
subgoal by (simp add: )
subgoal using mem_existence_ivl_iv_defined[OF ‹t ∈ existence_ivl t0 x0›] by simp
subgoal by (simp add: existence_ivl_subset)
subgoal by fact
done
lemma flow_unique_on:
assumes "t ∈ existence_ivl t0 x0"
assumes "phi t0 = x0"
assumes "(phi has_vderiv_on (λt. f t (phi t))) (existence_ivl t0 x0)"
assumes "⋀t. t ∈ existence_ivl t0 x0 ⟹ phi t ∈ X"
shows "flow t0 x0 t = phi t"
using flow_unique[where phi=phi, OF assms(1,2) _ assms(4)] assms(3)
by (auto simp: has_vderiv_on_open)
end
locale two_ll_on_open =
F: ll_on_open T1 F X + G: ll_on_open T2 G X
for F T1 G T2 X J x0 +
fixes e::real and K
assumes t0_in_J: "0 ∈ J"
assumes J_subset: "J ⊆ F.existence_ivl 0 x0"
assumes J_ivl: "is_interval J"
assumes F_lipschitz: "⋀t. t ∈ J ⟹ K-lipschitz_on X (F t)"
assumes K_pos: "0 < K"
assumes F_G_norm_ineq: "⋀t x. t ∈ J ⟹ x ∈ X ⟹ norm (F t x - G t x) < e"
begin
context begin
lemma F_iv_defined: "0 ∈ T1" "x0 ∈ X"
subgoal using F.existence_ivl_initial_time_iff J_subset t0_in_J by blast
subgoal using F.mem_existence_ivl_iv_defined(2) J_subset t0_in_J by blast
done
lemma e_pos: "0 < e"
using le_less_trans[OF norm_ge_zero F_G_norm_ineq[OF t0_in_J F_iv_defined(2)]]
by assumption
qualified definition "flow0 t = F.flow 0 x0 t"
qualified definition "Y t = G.flow 0 x0 t"
lemma norm_X_Y_bound:
shows "∀t ∈ J ∩ G.existence_ivl 0 x0. norm (flow0 t - Y t) ≤ e / K * (exp(K * ¦t¦) - 1)"
proof(safe)
fix t assume "t ∈ J"
assume tG: "t ∈ G.existence_ivl 0 x0"
have "0 ∈ J" by (simp add: t0_in_J)
let ?u="λt. norm (flow0 t - Y t)"
show "norm (flow0 t - Y t) ≤ e / K * (exp (K * ¦t¦) - 1)"
proof(cases "0 ≤ t")
assume "0 ≤ t"
hence [simp]: "¦t¦ = t" by simp
have t0_t_in_J: "{0..t} ⊆ J"
using ‹t ∈ J› ‹0 ∈ J› J_ivl
using mem_is_interval_1_I atLeastAtMost_iff subsetI by blast
note F_G_flow_cont[continuous_intros] =
continuous_on_subset[OF F.flow_continuous_on]
continuous_on_subset[OF G.flow_continuous_on]
have "?u t + e/K ≤ e/K * exp(K * t)"
proof(rule gronwall[where g="λt. ?u t + e/K", OF _ _ _ _ K_pos ‹0 ≤ t› order.refl])
fix s assume "0 ≤ s" "s ≤ t"
hence "{0..s} ⊆ J" using t0_t_in_J by auto
hence t0_s_in_existence:
"{0..s} ⊆ F.existence_ivl 0 x0"
"{0..s} ⊆ G.existence_ivl 0 x0"
using J_subset tG ‹0 ≤ s› ‹s ≤ t› G.ivl_subset_existence_ivl[OF tG]
by auto
hence s_in_existence:
"s ∈ F.existence_ivl 0 x0"
"s ∈ G.existence_ivl 0 x0"
using ‹0 ≤ s› by auto
note cont_statements[continuous_intros] =
F_iv_defined
F.flow_in_domain
G.flow_in_domain
F.mem_existence_ivl_subset
G.mem_existence_ivl_subset
have [integrable_on_simps]:
"continuous_on {0..s} (λs. F s (F.flow 0 x0 s))"
"continuous_on {0..s} (λs. G s (G.flow 0 x0 s))"
"continuous_on {0..s} (λs. F s (G.flow 0 x0 s))"
"continuous_on {0..s} (λs. G s (F.flow 0 x0 s))"
using t0_s_in_existence
by (auto intro!: continuous_intros integrable_continuous_real)
have "flow0 s - Y s = integral {0..s} (λs. F s (flow0 s) - G s (Y s))"
using ‹0 ≤ s›
by (simp add: flow0_def Y_def Henstock_Kurzweil_Integration.integral_diff integrable_on_simps ivl_integral_def
F.flow_fixed_point[OF s_in_existence(1)]
G.flow_fixed_point[OF s_in_existence(2)])
also have "... = integral {0..s} (λs. (F s (flow0 s) - F s (Y s)) + (F s (Y s) - G s (Y s)))"
by simp
also have "... = integral {0..s} (λs. F s (flow0 s) - F s (Y s)) + integral {0..s} (λs. F s (Y s) - G s (Y s))"
by (simp add: Henstock_Kurzweil_Integration.integral_diff Henstock_Kurzweil_Integration.integral_add flow0_def Y_def integrable_on_simps)
finally have "?u s ≤ norm (integral {0..s} (λs. F s (flow0 s) - F s (Y s))) + norm (integral {0..s} (λs. F s (Y s) - G s (Y s)))"
by (simp add: norm_triangle_ineq)
also have "... ≤ integral {0..s} (λs. norm (F s (flow0 s) - F s (Y s))) + integral {0..s} (λs. norm (F s (Y s) - G s (Y s)))"
using t0_s_in_existence
by (auto simp add: flow0_def Y_def
intro!: add_mono continuous_intros continuous_on_imp_absolutely_integrable_on)
also have "... ≤ integral {0..s} (λs. K * ?u s) + integral {0..s} (λs. e)"
proof (rule add_mono[OF integral_le integral_le])
show "norm (F x (flow0 x) - F x (Y x)) ≤ K * norm (flow0 x - Y x)" if "x ∈ {0..s}" for x
using F_lipschitz[unfolded lipschitz_on_def, THEN conjunct2] that
cont_statements(1,2,4)
t0_s_in_existence F_iv_defined
by (metis F_lipschitz flow0_def Y_def ‹{0..s} ⊆ J› lipschitz_on_normD F.flow_in_domain
G.flow_in_domain subsetCE)
show "⋀x. x ∈ {0..s} ⟹ norm (F x (Y x) - G x (Y x)) ≤ e"
using F_G_norm_ineq cont_statements(2,3) t0_s_in_existence
using Y_def ‹{0..s} ⊆ J› cont_statements(5) subset_iff G.flow_in_domain
by (metis eucl_less_le_not_le)
qed (simp_all add: t0_s_in_existence continuous_intros integrable_on_simps flow0_def Y_def)
also have "... = K * integral {0..s} (λs. ?u s + e / K)"
using K_pos t0_s_in_existence
by (simp_all add: algebra_simps Henstock_Kurzweil_Integration.integral_add flow0_def Y_def continuous_intros
continuous_on_imp_absolutely_integrable_on)
finally show "?u s + e / K ≤ e / K + K * integral {0..s} (λs. ?u s + e / K)"
by simp
next
show "continuous_on {0..t} (λt. norm (flow0 t - Y t) + e / K)"
using t0_t_in_J J_subset G.ivl_subset_existence_ivl[OF tG]
by (auto simp add: flow0_def Y_def intro!: continuous_intros)
next
fix s assume "0 ≤ s" "s ≤ t"
show "0 ≤ norm (flow0 s - Y s) + e / K"
using e_pos K_pos by simp
next
show "0 < e / K" using e_pos K_pos by simp
qed
thus ?thesis by (simp add: algebra_simps)
next
assume "¬0 ≤ t"
hence "t ≤ 0" by simp
hence [simp]: "¦t¦ = -t" by simp
have t0_t_in_J: "{t..0} ⊆ J"
using ‹t ∈ J› ‹0 ∈ J› J_ivl ‹¬ 0 ≤ t› atMostAtLeast_subset_convex is_interval_convex_1
by auto
note F_G_flow_cont[continuous_intros] =
continuous_on_subset[OF F.flow_continuous_on]
continuous_on_subset[OF G.flow_continuous_on]
have "?u t + e/K ≤ e/K * exp(- K * t)"
proof(rule gronwall_left[where g="λt. ?u t + e/K", OF _ _ _ _ K_pos order.refl ‹t ≤ 0›])
fix s assume "t ≤ s" "s ≤ 0"
hence "{s..0} ⊆ J" using t0_t_in_J by auto
hence t0_s_in_existence:
"{s..0} ⊆ F.existence_ivl 0 x0"
"{s..0} ⊆ G.existence_ivl 0 x0"
using J_subset G.ivl_subset_existence_ivl'[OF tG] ‹s ≤ 0› ‹t ≤ s›
by auto
hence s_in_existence:
"s ∈ F.existence_ivl 0 x0"
"s ∈ G.existence_ivl 0 x0"
using ‹s ≤ 0› by auto
note cont_statements[continuous_intros] =
F_iv_defined
F.flow_in_domain
G.flow_in_domain
F.mem_existence_ivl_subset
G.mem_existence_ivl_subset
then have [continuous_intros]:
"{s..0} ⊆ T1"
"{s..0} ⊆ T2"
"F.flow 0 x0 ` {s..0} ⊆ X"
"G.flow 0 x0 ` {s..0} ⊆ X"
"s ≤ x ⟹ x ≤ 0 ⟹ x ∈ F.existence_ivl 0 x0"
"s ≤ x ⟹ x ≤ 0 ⟹ x ∈ G.existence_ivl 0 x0" for x
using t0_s_in_existence
by (auto simp: )
have "flow0 s - Y s = - integral {s..0} (λs. F s (flow0 s) - G s (Y s))"
using t0_s_in_existence ‹s ≤ 0›
by (simp add: flow0_def Y_def ivl_integral_def
F.flow_fixed_point[OF s_in_existence(1)]
G.flow_fixed_point[OF s_in_existence(2)]
continuous_intros integrable_on_simps Henstock_Kurzweil_Integration.integral_diff)
also have "... = - integral {s..0} (λs. (F s (flow0 s) - F s (Y s)) + (F s (Y s) - G s (Y s)))"
by simp
also have "... = - (integral {s..0} (λs. F s (flow0 s) - F s (Y s)) + integral {s..0} (λs. F s (Y s) - G s (Y s)))"
using t0_s_in_existence
by (subst Henstock_Kurzweil_Integration.integral_add) (simp_all add: integral_add flow0_def Y_def continuous_intros integrable_on_simps)
finally have "?u s ≤ norm (integral {s..0} (λs. F s (flow0 s) - F s (Y s))) + norm (integral {s..0} (λs. F s (Y s) - G s (Y s)))"
by (metis (no_types, lifting) norm_minus_cancel norm_triangle_ineq)
also have "... ≤ integral {s..0} (λs. norm (F s (flow0 s) - F s (Y s))) + integral {s..0} (λs. norm (F s (Y s) - G s (Y s)))"
using t0_s_in_existence
by (auto simp add: flow0_def Y_def intro!: continuous_intros continuous_on_imp_absolutely_integrable_on add_mono)
also have "... ≤ integral {s..0} (λs. K * ?u s) + integral {s..0} (λs. e)"
proof (rule add_mono[OF integral_le integral_le])
show "norm (F x (flow0 x) - F x (Y x)) ≤ K * norm (flow0 x - Y x)" if "x∈{s..0}" for x
using F_lipschitz[unfolded lipschitz_on_def, THEN conjunct2]
cont_statements(1,2,4) that
t0_s_in_existence F_iv_defined
by (metis F_lipschitz flow0_def Y_def ‹{s..0} ⊆ J› lipschitz_on_normD F.flow_in_domain
G.flow_in_domain subsetCE)
show "⋀x. x ∈ {s..0} ⟹ norm (F x (Y x) - G x (Y x)) ≤ e"
using F_G_norm_ineq Y_def ‹{s..0} ⊆ J› cont_statements(5) subset_iff t0_s_in_existence(2)
using Y_def ‹{s..0} ⊆ J› cont_statements(5) subset_iff G.flow_in_domain
by (metis eucl_less_le_not_le)
qed (simp_all add: t0_s_in_existence continuous_intros integrable_on_simps flow0_def Y_def)
also have "... = K * integral {s..0} (λs. ?u s + e / K)"
using K_pos t0_s_in_existence
by (simp_all add: algebra_simps Henstock_Kurzweil_Integration.integral_add t0_s_in_existence continuous_intros integrable_on_simps flow0_def Y_def)
finally show "?u s + e / K ≤ e / K + K * integral {s..0} (λs. ?u s + e / K)"
by simp
next
show "continuous_on {t..0} (λt. norm (flow0 t - Y t) + e / K)"
using t0_t_in_J J_subset G.ivl_subset_existence_ivl'[OF tG] F_iv_defined
by (auto simp add: flow0_def Y_def intro!: continuous_intros)
next
fix s assume "t ≤ s" "s ≤ 0"
show "0 ≤ norm (flow0 s - Y s) + e / K"
using e_pos K_pos by simp
next
show "0 < e / K" using e_pos K_pos by simp
qed
thus ?thesis by (simp add: algebra_simps)
qed
qed
end
end
locale auto_ll_on_open =
fixes f::"'a::{banach, heine_borel} ⇒ 'a" and X
assumes auto_local_lipschitz: "local_lipschitz UNIV X (λ_::real. f)"
assumes auto_open_domain[intro!, simp]: "open X"
begin
text ‹autonomous flow and existence interval ›
definition "flow0 x0 t = ll_on_open.flow UNIV (λ_. f) X 0 x0 t"
definition "existence_ivl0 x0 = ll_on_open.existence_ivl UNIV (λ_. f) X 0 x0"
sublocale ll_on_open_it UNIV "λ_. f" X 0
rewrites "flow = (λt0 x0 t. flow0 x0 (t - t0))"
and "existence_ivl = (λt0 x0. (+) t0 ` existence_ivl0 x0)"
and "(+) 0 = (λx::real. x)"
and "s - 0 = s"
and "(λx. x) ` S = S"
and "s ∈ (+) t ` S ⟷ s - t ∈ (S::real set)"
and "P (s + t - s) = P (t::real)"
and "P (t + s - s) = P t"
proof -
interpret ll_on_open UNIV "λ_. f" X
by unfold_locales (auto intro!: continuous_on_const auto_local_lipschitz)
show "ll_on_open_it UNIV (λ_. f) X" ..
show "(+) 0 = (λx::real. x)" "(λx. x) ` S = S" "s - 0 = s" "P (t + s - s) = P t" "P (s + t - s) = P (t::real)"
by auto
show "flow = (λt0 x0 t. flow0 x0 (t - t0))"
unfolding flow0_def
apply (rule ext)
apply (rule ext)
apply (rule flow_eq_in_existence_ivlI)
apply (auto intro: flow_shift_autonomous1
mem_existence_ivl_shift_autonomous1 mem_existence_ivl_shift_autonomous2)
done
show "existence_ivl = (λt0 x0. (+) t0 ` existence_ivl0 x0)"
unfolding existence_ivl0_def
apply (safe intro!: ext)
subgoal using image_iff mem_existence_ivl_shift_autonomous1 by fastforce
subgoal premises prems for t0 x0 x s
proof -
have f2: "∀x1 x2. (x2::real) - x1 = - 1 * x1 + x2"
by auto
have "- 1 * t0 + (t0 + s) = s"
by auto
then show ?thesis
using f2 prems mem_existence_ivl_iv_defined(2) mem_existence_ivl_shift_autonomous2
by presburger
qed
done
show "(s ∈ (+) t ` S) = (s - t ∈ S)" by force
qed
lemma existence_ivl_zero: "x0 ∈ X ⟹ 0 ∈ existence_ivl0 x0" by simp
lemmas [continuous_intros del] = continuous_on_f
lemmas continuous_on_f_comp[continuous_intros] = continuous_on_f[OF continuous_on_const _ subset_UNIV]
lemma
flow_in_compact_right_existence:
assumes "⋀t. 0 ≤ t ⟹ t ∈ existence_ivl0 x ⟹ flow0 x t ∈ K"
assumes "compact K" "K ⊆ X"
assumes "x ∈ X" "t ≥ 0"
shows "t ∈ existence_ivl0 x"
proof (rule ccontr)
assume "t ∉ existence_ivl0 x"
have "bdd_above (existence_ivl0 x)"
by (rule bdd_above_is_intervalI[OF is_interval_existence_ivl ‹0 ≤ t› existence_ivl_zero]) fact+
from sup_existence_maximal[OF UNIV_I ‹x ∈ X› assms(1-3) this]
show False by auto
qed
lemma
flow_in_compact_left_existence:
assumes "⋀t. t ≤ 0 ⟹ t ∈ existence_ivl0 x ⟹ flow0 x t ∈ K"
assumes "compact K" "K ⊆ X"
assumes "x ∈ X" "t ≤ 0"
shows "t ∈ existence_ivl0 x"
proof (rule ccontr)
assume "t ∉ existence_ivl0 x"
have "bdd_below (existence_ivl0 x)"
by (rule bdd_below_is_intervalI[OF is_interval_existence_ivl ‹t ≤ 0› _ existence_ivl_zero]) fact+
from inf_existence_minimal[OF UNIV_I ‹x ∈ X› assms(1-3) this]
show False by auto
qed
end
locale compact_continuously_diff =
derivative_on_prod T X f "λ(t, x). f' x o⇩L snd_blinfun"
for T X and f::"real ⇒ 'a::{banach,perfect_space,heine_borel} ⇒ 'a"
and f'::"'a ⇒ ('a, 'a) blinfun" +
assumes compact_domain: "compact X"
assumes convex: "convex X"
assumes nonempty_domains: "T ≠ {}" "X ≠ {}"
assumes continuous_derivative: "continuous_on X f'"
begin
lemma ex_onorm_bound:
"∃B. ∀x ∈ X. norm (f' x) ≤ B"
proof -
from _ compact_domain have "compact (f' ` X)"
by (intro compact_continuous_image continuous_derivative)
hence "bounded (f' ` X)" by (rule compact_imp_bounded)
thus ?thesis
by (auto simp add: bounded_iff cball_def norm_blinfun.rep_eq)
qed
definition "onorm_bound = (SOME B. ∀x ∈ X. norm (f' x) ≤ B)"
lemma onorm_bound: assumes "x ∈ X" shows "norm (f' x) ≤ onorm_bound"
unfolding onorm_bound_def
using someI_ex[OF ex_onorm_bound] assms
by blast
sublocale closed_domain X
using compact_domain by unfold_locales (rule compact_imp_closed)
sublocale global_lipschitz T X f onorm_bound
proof (unfold_locales, rule lipschitz_onI)
fix t z y
assume "t ∈ T" "y ∈ X" "z ∈ X"
then have "norm (f t y - f t z) ≤ onorm_bound * norm (y - z)"
using onorm_bound
by (intro differentiable_bound[where f'=f', OF convex])
(auto intro!: derivative_eq_intros simp: norm_blinfun.rep_eq)
thus "dist (f t y) (f t z) ≤ onorm_bound * dist y z"
by (auto simp: dist_norm norm_Pair)
next
from nonempty_domains obtain x where x: "x ∈ X" by auto
show "0 ≤ onorm_bound"
using dual_order.trans local.onorm_bound norm_ge_zero x by blast
qed
end
locale unique_on_compact_continuously_diff = self_mapping +
compact_interval T +
compact_continuously_diff T X f
begin
sublocale unique_on_closed t0 T x0 f X onorm_bound
by unfold_locales (auto intro!: f' has_derivative_continuous_on)
end
locale c1_on_open =
fixes f::"'a::{banach, perfect_space, heine_borel} ⇒ 'a" and f' X
assumes open_dom[simp]: "open X"
assumes derivative_rhs:
"⋀x. x ∈ X ⟹ (f has_derivative blinfun_apply (f' x)) (at x)"
assumes continuous_derivative: "continuous_on X f'"
begin
lemmas continuous_derivative_comp[continuous_intros] =
continuous_on_compose2[OF continuous_derivative]
lemma derivative_tendsto[tendsto_intros]:
assumes [tendsto_intros]: "(g ⤏ l) F"
and "l ∈ X"
shows "((λx. f' (g x)) ⤏ f' l) F"
using continuous_derivative[simplified continuous_on] assms
by (auto simp: at_within_open[OF _ open_dom]
intro!: tendsto_eq_intros
intro: tendsto_compose)
lemma c1_on_open_rev[intro, simp]: "c1_on_open (-f) (-f') X"
using derivative_rhs continuous_derivative
by unfold_locales
(auto intro!: continuous_intros derivative_eq_intros
simp: fun_Compl_def blinfun.bilinear_simps)
lemma derivative_rhs_compose[derivative_intros]:
"((g has_derivative g') (at x within s)) ⟹ g x ∈ X ⟹
((λx. f (g x)) has_derivative
(λxa. blinfun_apply (f' (g x)) (g' xa)))
(at x within s)"
by (metis has_derivative_compose[of g g' x s f "f' (g x)"] derivative_rhs)
sublocale auto_ll_on_open
proof (standard, rule local_lipschitzI)
fix x and t::real
assume "x ∈ X"
with open_contains_cball[of "UNIV::real set"] open_UNIV
open_contains_cball[of X] open_dom
obtain u v where uv: "cball t u ⊆ UNIV" "cball x v ⊆ X" "u > 0" "v > 0"
by blast
let ?T = "cball t u" and ?X = "cball x v"
have "bounded ?X" by simp
have "compact (cball x v)"
by simp
interpret compact_continuously_diff ?T ?X "λ_. f" f'
using uv
by unfold_locales
(auto simp: convex_cball cball_eq_empty split_beta'
intro!: derivative_eq_intros continuous_on_compose2[OF continuous_derivative]
continuous_intros)
have "onorm_bound-lipschitz_on ?X f"
using lipschitz[of t] uv
by auto
thus "∃u>0. ∃L. ∀t ∈ cball t u ∩ UNIV. L-lipschitz_on (cball x u ∩ X) f"
by (intro exI[where x=v])
(auto intro!: exI[where x=onorm_bound] ‹0 < v› simp: Int_absorb2 uv)
qed (auto intro!: continuous_intros)
end
locale c1_on_open_euclidean = c1_on_open f f' X
for f::"'a::euclidean_space ⇒ _" and f' X
begin
lemma c1_on_open_euclidean_anchor: True ..
definition "vareq x0 t = f' (flow0 x0 t)"
interpretation var: ll_on_open "existence_ivl0 x0" "vareq x0" UNIV
apply standard
apply (auto intro!: c1_implies_local_lipschitz[where f' = "λ(t, x). vareq x0 t"] continuous_intros
derivative_eq_intros
simp: split_beta' blinfun.bilinear_simps vareq_def)
using local.mem_existence_ivl_iv_defined(2) apply blast
using local.existence_ivl_reverse local.mem_existence_ivl_iv_defined(2) apply blast
using local.mem_existence_ivl_iv_defined(2) apply blast
using local.existence_ivl_reverse local.mem_existence_ivl_iv_defined(2) apply blast
done
context begin
lemma continuous_on_A[continuous_intros]:
assumes "continuous_on S a"
assumes "continuous_on S b"
assumes "⋀s. s ∈ S ⟹ a s ∈ X"
assumes "⋀s. s ∈ S ⟹ b s ∈ existence_ivl0 (a s)"
shows "continuous_on S (λs. vareq (a s) (b s))"
proof -
have "continuous_on S (λx. f' (flow0 (a x) (b x)))"
by (auto intro!: continuous_intros assms flow_in_domain)
then show ?thesis
by (rule continuous_on_eq) (auto simp: assms vareq_def)
qed
lemmas [intro] = mem_existence_ivl_iv_defined
context
fixes x0::'a
begin
lemma flow0_defined: "xa ∈ existence_ivl0 x0 ⟹ flow0 x0 xa ∈ X"
by (auto simp: flow_in_domain)
lemma continuous_on_flow0: "continuous_on (existence_ivl0 x0) (flow0 x0)"
by (auto simp: intro!: continuous_intros)
lemmas continuous_on_flow0_comp[continuous_intros] = continuous_on_compose2[OF continuous_on_flow0]
lemma varexivl_eq_exivl:
assumes "t ∈ existence_ivl0 x0"
shows "var.existence_ivl x0 t a = existence_ivl0 x0"
proof (rule var.existence_ivl_eq_domain)
fix s t x
assume s: "s ∈ existence_ivl0 x0" and t: "t ∈ existence_ivl0 x0"
then have "{s .. t} ⊆ existence_ivl0 x0"
by (metis atLeastatMost_empty_iff2 empty_subsetI real_Icc_closed_segment var.closed_segment_subset_domain)
then have "continuous_on {s .. t} (vareq x0)"
by (auto simp: closed_segment_eq_real_ivl intro!: continuous_intros flow0_defined)
then have "compact ((vareq x0) ` {s .. t})"
using compact_Icc
by (rule compact_continuous_image)
then obtain B where B: "⋀u. u ∈ {s .. t} ⟹ norm (vareq x0 u) ≤ B"
by (force dest!: compact_imp_bounded simp: bounded_iff)
show "∃M L. ∀t∈{s..t}. ∀x∈UNIV. norm (blinfun_apply (vareq x0 t) x) ≤ M + L * norm x"
by (rule exI[where x=0], rule exI[where x=B])
(auto intro!: order_trans[OF norm_blinfun] mult_right_mono B simp:)
qed (auto intro: assms)
definition "vector_Dflow u0 t ≡ var.flow x0 0 u0 t"
qualified abbreviation "Y z t ≡ flow0 (x0 + z) t"
text ‹Linearity of the solution to the variational equation.
TODO: generalize this and some other things for arbitrary linear ODEs›
lemma vector_Dflow_linear:
assumes "t ∈ existence_ivl0 x0"
shows "vector_Dflow (α *⇩R a + β *⇩R b) t = α *⇩R vector_Dflow a t + β *⇩R vector_Dflow b t"
proof -
note mem_existence_ivl_iv_defined[OF assms, intro, simp]
have "((λc. α *⇩R var.flow x0 0 a c + β *⇩R var.flow x0 0 b c) solves_ode (λx. vareq x0 x)) (existence_ivl0 x0) UNIV"
by (auto intro!: derivative_intros var.flow_has_vector_derivative solves_odeI
simp: blinfun.bilinear_simps varexivl_eq_exivl vareq_def[symmetric])
moreover
have "α *⇩R var.flow x0 0 a 0 + β *⇩R var.flow x0 0 b 0 = α *⇩R a + β *⇩R b" by simp
moreover note is_interval_existence_ivl[of x0]
ultimately show ?thesis
unfolding vareq_def[symmetric] vector_Dflow_def
by (rule var.maximal_existence_flow) (auto simp: assms)
qed
lemma linear_vector_Dflow:
assumes "t ∈ existence_ivl0 x0"
shows "linear (λz. vector_Dflow z t)"
using vector_Dflow_linear[OF assms, of 1 _ 1] vector_Dflow_linear[OF assms, of _ _ 0]
by (auto intro!: linearI)
lemma bounded_linear_vector_Dflow:
assumes "t ∈ existence_ivl0 x0"
shows "bounded_linear (λz. vector_Dflow z t)"
by (simp add: linear_linear linear_vector_Dflow assms)
lemma vector_Dflow_continuous_on_time: "x0 ∈ X ⟹ continuous_on (existence_ivl0 x0) (λt. vector_Dflow z t)"
using var.flow_continuous_on[of x0 0 z] varexivl_eq_exivl
unfolding vector_Dflow_def
by (auto simp: )
proposition proposition_17_6_weak:
assumes "t ∈ existence_ivl0 x0"
shows "(λy. (Y (y - x0) t - flow0 x0 t - vector_Dflow (y - x0) t) /⇩R norm (y - x0)) ─ x0 → 0"
proof-
note x0_def = mem_existence_ivl_iv_defined[OF assms]
have "0 ∈ existence_ivl0 x0"
by (simp add: x0_def)
text ‹Find some ‹J ⊆ existence_ivl0 x0› with ‹0 ∈ J› and ‹t ∈ J›.›
define t0 where "t0 ≡ min 0 t"
define t1 where "t1 ≡ max 0 t"
define J where "J ≡ {t0..t1}"
have "t0 ≤ 0" "0 ≤ t1" "0 ∈ J" "J ≠ {}" "t ∈ J" "compact J"
and J_in_existence: "J ⊆ existence_ivl0 x0"
using ivl_subset_existence_ivl ivl_subset_existence_ivl' x0_def assms
by (auto simp add: J_def t0_def t1_def min_def max_def)
{
fix z S
assume assms: "x0 + z ∈ X" "S ⊆ existence_ivl0 (x0 + z)"
have "continuous_on S (Y z)"
using flow_continuous_on assms(1)
by (intro continuous_on_subset[OF _ assms(2)]) (simp add:)
}
note [continuous_intros] = this integrable_continuous_real blinfun.continuous_on
have U_continuous[continuous_intros]: "⋀z. continuous_on J (vector_Dflow z)"
by(rule continuous_on_subset[OF vector_Dflow_continuous_on_time[OF ‹x0 ∈ X›] J_in_existence])
from ‹t ∈ J›
have "t0 ≤ t"
and "t ≤ t1"
and "t0 ≤ t1"
and "t0 ∈ existence_ivl0 x0"
and "t ∈ existence_ivl0 x0"
and "t1 ∈ existence_ivl0 x0"
using J_def J_in_existence by auto
from global_existence_ivl_explicit[OF ‹t0 ∈ existence_ivl0 x0› ‹t1 ∈ existence_ivl0 x0› ‹t0 ≤ t1›]
obtain u K where uK_def:
"0 < u"
"0 < K"
"ball x0 u ⊆ X"
"⋀y. y ∈ ball x0 u ⟹ t0 ∈ existence_ivl0 y"
"⋀y. y ∈ ball x0 u ⟹ t1 ∈ existence_ivl0 y"
"⋀t y. y ∈ ball x0 u ⟹ t ∈ J ⟹ dist (flow0 x0 t) (Y (y - x0) t) ≤ dist x0 y * exp (K * ¦t¦)"
by (auto simp add: J_def)
have J_in_existence_ivl: "⋀y. y ∈ ball x0 u ⟹ J ⊆ existence_ivl0 y"
unfolding J_def
using uK_def
by (simp add: real_Icc_closed_segment segment_subset_existence_ivl t0_def t1_def)
have ball_in_X: "⋀z. z ∈ ball 0 u ⟹ x0 + z ∈ X"
using uK_def(3)
by (auto simp: dist_norm)
have flow0_J_props: "flow0 x0 ` J ≠ {}" "compact (flow0 x0 ` J)" "flow0 x0` J ⊆ X"
using ‹t0 ≤ t1›
using J_def(1) J_in_existence
by (auto simp add: J_def intro!:
compact_continuous_image continuous_intros flow_in_domain)
have [continuous_intros]: "continuous_on J (λs. f' (flow0 x0 s))"
using J_in_existence
by (auto intro!: continuous_intros flow_in_domain simp:)
text ‹ Show the thesis via cases ‹t = 0›, ‹0 < t› and ‹t < 0›. ›
show ?thesis
proof(cases "t = 0")
assume "t = 0"
show ?thesis
unfolding ‹t = 0› Lim_at
proof(simp add: dist_norm[of _ 0] del: zero_less_dist_iff, safe, rule exI, rule conjI[OF ‹0 < u›], safe)
fix e::real and x assume "0 < e" "0 < dist x x0" "dist x x0 < u"
hence "x ∈ X"
using uK_def(3)
by (auto simp: dist_commute)
hence "inverse (norm (x - x0)) * norm (Y (x - x0) 0 - flow0 x0 0 - vector_Dflow (x - x0) 0) = 0"
using x0_def
by (simp add: vector_Dflow_def)
thus "inverse (norm (x - x0)) * norm (flow0 x 0 - flow0 x0 0 - vector_Dflow (x - x0) 0) < e"
using ‹0 < e› by auto
qed
next
assume "t ≠ 0"
show ?thesis
proof(unfold Lim_at, safe)
fix e::real assume "0 < e"
then obtain e' where "0 < e'" "e' < e"
using dense by auto
obtain N
where N_ge_SupS: "Sup { norm (f' (flow0 x0 s)) |s. s ∈ J } ≤ N" (is "Sup ?S ≤ N")
and N_gr_0: "0 < N"
by (meson le_cases less_le_trans linordered_field_no_ub)
have N_ineq: "⋀s. s ∈ J ⟹ norm (f' (flow0 x0 s)) ≤ N"
proof-
fix s assume "s ∈ J"
have "?S = (norm o f' o flow0 x0) ` J" by auto
moreover have "continuous_on J (norm o f' o flow0 x0)"
using J_in_existence
by (auto intro!: continuous_intros)
ultimately have "∃a b. ?S = {a..b} ∧ a ≤ b"
using continuous_image_closed_interval[OF ‹t0 ≤ t1›]
by (simp add: J_def)
then obtain a b where "?S = {a..b}" and "a ≤ b" by auto
hence "bdd_above ?S" by simp
from ‹s ∈ J› cSup_upper[OF _ this]
have "norm (f' (flow0 x0 s)) ≤ Sup ?S"
by auto
thus "norm (f' (flow0 x0 s)) ≤ N"
using N_ge_SupS by simp
qed
text ‹ Define a small region around ‹flow0 ` J›, that is a subset of the domain ‹X›. ›
from compact_in_open_separated[OF flow0_J_props(1,2) auto_open_domain flow0_J_props(3)]
obtain e_domain where e_domain_def: "0 < e_domain" "{x. infdist x (flow0 x0 ` J) ≤ e_domain} ⊆ X"
by auto
define G where "G ≡ {x∈X. infdist x (flow0 x0 ` J) < e_domain}"
have G_vimage: "G = ((λx. infdist x (flow0 x0 ` J)) -` {..<e_domain}) ∩ X"
by (auto simp: G_def)
have "open G" "G ⊆ X"
unfolding G_vimage
by (auto intro!: open_Int open_vimage continuous_intros continuous_at_imp_continuous_on)
text ‹Define a compact subset H of G. Inside H, we can guarantee
an upper bound on the Taylor remainder.›
define e_domain2 where "e_domain2 ≡ e_domain / 2"
have "e_domain2 > 0" "e_domain2 < e_domain" using ‹e_domain > 0›
by (simp_all add: e_domain2_def)
define H where "H ≡ {x. infdist x (flow0 x0 ` J) ≤ e_domain2}"
have H_props: "H ≠ {}" "compact H" "H ⊆ G"
proof-
have "x0 ∈ flow0 x0 ` J"
unfolding image_iff
using ‹0 ∈ J› x0_def
by force
hence "x0 ∈ H"
using ‹0 < e_domain2›
by (simp add: H_def x0_def)
thus "H ≠ {}"
by auto
next
show "compact H"
unfolding H_def
using ‹0 < e_domain2› flow0_J_props
by (intro compact_infdist_le) simp_all
next
show "H ⊆ G"
proof
fix x assume "x ∈ H"
then have *: "infdist x (flow0 x0 ` J) < e_domain"
using ‹0 < e_domain›
by (simp add: H_def e_domain2_def)
then have "x ∈ X"
using e_domain_def(2)
by auto
with * show "x ∈ G"
unfolding G_def
by auto
qed
qed
have f'_cont_on_G: "(⋀x. x ∈ G ⟹ isCont f' x)"
using continuous_on_interior[OF continuous_on_subset[OF continuous_derivative ‹G ⊆ X›]]
by (simp add: interior_open[OF ‹open G›])
define e1 where "e1 ≡ e' / (¦t¦ * exp (K * ¦t¦) * exp (N * ¦t¦))"
have "0 < ¦t¦"
using ‹t ≠ 0›
by simp
hence "0 < e1"
using ‹0 < e'›
by (simp add: e1_def)
text ‹ Taylor expansion of f on set G. ›
from uniform_explicit_remainder_Taylor_1[where f=f and f'=f',
OF derivative_rhs[OF subsetD[OF ‹G ⊆ X›]] f'_cont_on_G ‹open G› H_props ‹0 < e1›]
obtain d_Taylor R
where Taylor_expansion:
"0 < d_Taylor"
"⋀x z. f z = f x + (f' x) (z - x) + R x z"
"⋀x y. x ∈ H ⟹ y ∈ H ⟹ dist x y < d_Taylor ⟹ norm (R x y) ≤ e1 * dist x y"
"continuous_on (G × G) (λ(a, b). R a b)"
by auto
text ‹ Find d, such that solutions are always at least ‹min (e_domain/2) d_Taylor› apart,
i.e. always in H. This later gives us the bound on the remainder. ›
have "0 < min (e_domain/2) d_Taylor"
using ‹0 < d_Taylor› ‹0 < e_domain›
by auto
from uniform_limit_flow[OF ‹t0 ∈ existence_ivl0 x0› ‹t1 ∈ existence_ivl0 x0› ‹t0 ≤ t1›,
THEN uniform_limitD, OF this, unfolded eventually_at]
obtain d_ivl where d_ivl_def:
"0 < d_ivl"
"⋀x. 0 < dist x x0 ⟹ dist x x0 < d_ivl ⟹
(∀t∈J. dist (flow0 x0 t) (Y (x - x0) t) < min (e_domain / 2) d_Taylor)"
by (auto simp: dist_commute J_def)
define d where "d ≡ min u d_ivl"
have "0 < d" using ‹0 < u› ‹0 < d_ivl›
by (simp add: d_def)
hence "d ≤ u" "d ≤ d_ivl"
by (auto simp: d_def)
text ‹ Therefore, any flow0 starting in ‹ball x0 d› will be in G. ›
have Y_in_G: "⋀y. y ∈ ball x0 d ⟹ (λs. Y (y - x0) s) ` J ⊆ G"
proof
fix x y assume assms: "y ∈ ball x0 d" "x ∈ (λs. Y (y - x0) s) ` J"
show "x ∈ G"
proof(cases)
assume "y = x0"
from assms(2)
have "x ∈ flow0 x0 ` J"
by (simp add: ‹y = x0›)
thus "x ∈ G"
using ‹0 < e_domain› ‹flow0 x0 ` J ⊆ X›
by (auto simp: G_def)
next
assume "y ≠ x0"
hence "0 < dist y x0"
by (simp add: dist_norm)
from d_ivl_def(2)[OF this] ‹d ≤ d_ivl› ‹0 < e_domain› assms(1)
have dist_flow0_Y: "⋀t. t ∈ J ⟹ dist (flow0 x0 t) (Y (y - x0) t) < e_domain"
by (auto simp: dist_commute)
from assms(2)
obtain t where t_def: "t ∈ J" "x = Y (y - x0) t"
by auto
have "x ∈ X"
unfolding t_def(2)
using uK_def(3) assms(1) ‹d ≤ u› subsetD[OF J_in_existence_ivl t_def(1)]
by (auto simp: intro!: flow_in_domain)
have "flow0 x0 t ∈ flow0 x0 ` J" using t_def by auto
from dist_flow0_Y[OF t_def(1)]
have "dist x (flow0 x0 t) < e_domain"
by (simp add: t_def(2) dist_commute)
from le_less_trans[OF infdist_le[OF ‹flow0 x0 t ∈ flow0 x0 ` J›] this] ‹x ∈ X›
show "x ∈ G"
by (auto simp: G_def)
qed
qed
from this[of x0] ‹0 < d›
have X_in_G: "flow0 x0 ` J ⊆ G"
by (simp add: )
show "∃d>0. ∀x. 0 < dist x x0 ∧ dist x x0 < d ⟶
dist ((Y (x - x0) t - flow0 x0 t - vector_Dflow (x - x0) t) /⇩R norm (x - x0)) 0 < e"
proof(rule exI, rule conjI[OF ‹0 < d›], safe, unfold norm_conv_dist[symmetric])
fix x assume x_x0_dist: "0 < dist x x0" "dist x x0 < d"
hence x_in_ball': "x ∈ ball x0 d"
by (simp add: dist_commute)
hence x_in_ball: "x ∈ ball x0 u"
using ‹d ≤ u›
by simp
text ‹ First, some prerequisites. ›
from x_in_ball
have z_in_ball: "x - x0 ∈ ball 0 u"
using ‹0 < u›
by (simp add: dist_norm)
hence [continuous_intros]: "dist x0 x < u"
by (auto simp: dist_norm)
from J_in_existence_ivl[OF x_in_ball]
have J_in_existence_ivl_x: "J ⊆ existence_ivl0 x" .
from ball_in_X[OF z_in_ball]
have x_in_X[continuous_intros]: "x ∈ X"
by simp
text ‹ On all of ‹J›, we can find upper bounds for the distance of ‹flow0› and ‹Y›. ›
have dist_flow0_Y: "⋀s. s ∈ J ⟹ dist (flow0 x0 s) (Y (x - x0) s) ≤ dist x0 x * exp (K * ¦t¦)"
using t0_def t1_def uK_def(2)
by (intro order_trans[OF uK_def(6)[OF x_in_ball] mult_left_mono])
(auto simp add: J_def intro!: mult_mono)
from d_ivl_def x_x0_dist ‹d ≤ d_ivl›
have dist_flow0_Y2: "⋀t. t ∈ J ⟹ dist (flow0 x0 t) (Y (x - x0) t) < min (e_domain2) d_Taylor"
by (auto simp: e_domain2_def)
let ?g = "λt. norm (Y (x - x0) t - flow0 x0 t - vector_Dflow (x - x0) t)"
let ?C = "¦t¦ * dist x0 x * exp (K * ¦t¦) * e1"
text ‹ Find an upper bound to ‹?g›, i.e. show that
‹?g s ≤ ?C + N * integral {a..b} ?g›
for ‹{a..b} = {0..s}› or ‹{a..b} = {s..0}› for some ‹s ∈ J›.
We can then apply Grönwall's inequality to obtain a true bound for ‹?g›. ›
have g_bound: "?g s ≤ ?C + N * integral {a..b} ?g"
if s_def: "s ∈ {a..b}"
and J'_def: "{a..b} ⊆ J"
and ab_cases: "(a = 0 ∧ b = s) ∨ (a = s ∧ b = 0)"
for s a b
proof -
from that have "s ∈ J" by auto
have s_in_existence_ivl_x0: "s ∈ existence_ivl0 x0"
using J_in_existence ‹s ∈ J› by auto
have s_in_existence_ivl: "⋀y. y ∈ ball x0 u ⟹ s ∈ existence_ivl0 y"
using J_in_existence_ivl ‹s ∈ J› by auto
have s_in_existence_ivl2: "⋀z. z ∈ ball 0 u ⟹ s ∈ existence_ivl0 (x0 + z)"
using s_in_existence_ivl
by (simp add: dist_norm)
text ‹Prove continuities beforehand.›
note continuous_on_0_s[continuous_intros] = continuous_on_subset[OF _ ‹{a..b} ⊆ J›]
have[continuous_intros]: "continuous_on J (flow0 x0)"
using J_in_existence
by (auto intro!: continuous_intros simp:)
{
fix z S
assume assms: "x0 + z ∈ X" "S ⊆ existence_ivl0 (x0 + z)"
have "continuous_on S (λs. f (Y z s))"
proof(rule continuous_on_subset[OF _ assms(2)])
show "continuous_on (existence_ivl0 (x0 + z)) (λs. f (Y z s))"
using assms
by (auto intro!: continuous_intros flow_in_domain flow_continuous_on simp:)
qed
}
note [continuous_intros] = this
have [continuous_intros]: "continuous_on J (λs. f (flow0 x0 s))"
by(rule continuous_on_subset[OF _ J_in_existence])
(auto intro!: continuous_intros flow_continuous_on flow_in_domain simp: x0_def)
have [continuous_intros]: "⋀z. continuous_on J (λs. f' (flow0 x0 s) (vector_Dflow z s))"
proof-
fix z
have a1: "continuous_on J (flow0 x0)"
by (auto intro!: continuous_intros)
have a2: "(λs. (flow0 x0 s, vector_Dflow z s)) ` J ⊆ (flow0 x0 ` J) × ((λs. vector_Dflow z s) ` J)"
by auto
have a3: "continuous_on ((λs. (flow0 x0 s, vector_Dflow z s)) ` J) (λ(x, u). f' x u)"
using assms flow0_J_props
by (auto intro!: continuous_intros simp: split_beta')
from continuous_on_compose[OF continuous_on_Pair[OF a1 U_continuous] a3]
show "continuous_on J (λs. f' (flow0 x0 s) (vector_Dflow z s))"
by simp
qed
have [continuous_intros]: "continuous_on J (λs. R (flow0 x0 s) (Y (x - x0) s))"
using J_in_existence J_in_existence_ivl[OF x_in_ball] X_in_G ‹{a..b} ⊆ J› Y_in_G
x_x0_dist
by (auto intro!: continuous_intros continuous_on_compose_Pair[OF Taylor_expansion(4)]
simp: dist_commute subset_iff)
hence [continuous_intros]:
"(λs. R (flow0 x0 s) (Y (x - x0) s)) integrable_on J"
unfolding J_def
by (rule integrable_continuous_real)
have i1: "integral {a..b} (λs. f (flow0 x s)) - integral {a..b} (λs. f (flow0 x0 s)) =
integral {a..b} (λs. f (flow0 x s) - f (flow0 x0 s))"
using J_in_existence_ivl[OF x_in_ball]
apply (intro Henstock_Kurzweil_Integration.integral_diff[symmetric])
by (auto intro!: continuous_intros existence_ivl_reverse)
have i2:
"integral {a..b} (λs. f (flow0 x s) - f (flow0 x0 s) - (f' (flow0 x0 s)) (vector_Dflow (x - x0) s)) =
integral {a..b} (λs. f (flow0 x s) - f (flow0 x0 s)) -
integral {a..b} (λs. f' (flow0 x0 s) (vector_Dflow (x - x0) s))"
using J_in_existence_ivl[OF x_in_ball]
by (intro Henstock_Kurzweil_Integration.integral_diff[OF Henstock_Kurzweil_Integration.integrable_diff])
(auto intro!: continuous_intros existence_ivl_reverse)
from ab_cases
have "?g s = norm (integral {a..b} (λs'. f (Y (x - x0) s')) -
integral {a..b} (λs'. f (flow0 x0 s')) -
integral {a..b} (λs'. (f' (flow0 x0 s')) (vector_Dflow (x - x0) s')))"
proof(safe)
assume "a = 0" "b = s"
hence "0 ≤ s" using ‹s ∈ {a..b}› by simp
text‹ Integral equations for flow0, Y and U. ›
have flow0_integral_eq: "flow0 x0 s = x0 + ivl_integral 0 s (λs. f (flow0 x0 s))"
by (rule flow_fixed_point[OF s_in_existence_ivl_x0])
have Y_integral_eq: "flow0 x s = x0 + (x - x0) + ivl_integral 0 s (λs. f (Y (x - x0) s))"
using flow_fixed_point ‹0 ≤ s› s_in_existence_ivl2[OF z_in_ball] ball_in_X[OF z_in_ball]
by (simp add:)
have U_integral_eq: "vector_Dflow (x - x0) s = (x - x0) + ivl_integral 0 s (λs. vareq x0 s (vector_Dflow (x - x0) s))"
unfolding vector_Dflow_def
by (rule var.flow_fixed_point)
(auto simp: ‹0 ≤ s› x0_def varexivl_eq_exivl s_in_existence_ivl_x0)
show "?g s = norm (integral {0..s} (λs'. f (Y (x - x0) s')) -
integral {0..s} (λs'. f (flow0 x0 s')) -
integral {0..s} (λs'. blinfun_apply (f' (flow0 x0 s')) (vector_Dflow (x - x0) s')))"
using ‹0 ≤ s›
unfolding vareq_def[symmetric]
by (simp add: flow0_integral_eq Y_integral_eq U_integral_eq ivl_integral_def)
next
assume "a = s" "b = 0"
hence "s ≤ 0" using ‹s ∈ {a..b}› by simp
have flow0_integral_eq_left: "flow0 x0 s = x0 + ivl_integral 0 s (λs. f (flow0 x0 s))"
by (rule flow_fixed_point[OF s_in_existence_ivl_x0])
have Y_integral_eq_left: "Y (x - x0) s = x0 + (x - x0) + ivl_integral 0 s (λs. f (Y (x - x0) s))"
using flow_fixed_point ‹s ≤ 0› s_in_existence_ivl2[OF z_in_ball] ball_in_X[OF z_in_ball]
by (simp add: )
have U_integral_eq_left: "vector_Dflow (x - x0) s = (x - x0) + ivl_integral 0 s (λs. vareq x0 s (vector_Dflow (x - x0) s))"
unfolding vector_Dflow_def
by (rule var.flow_fixed_point)
(auto simp: ‹s ≤ 0› x0_def varexivl_eq_exivl s_in_existence_ivl_x0)
have "?g s =
norm (- integral {s..0} (λs'. f (Y (x - x0) s')) +
integral {s..0} (λs'. f (flow0 x0 s')) +
integral {s..0} (λs'. vareq x0 s' (vector_Dflow (x - x0) s')))"
unfolding flow0_integral_eq_left Y_integral_eq_left U_integral_eq_left
using ‹s ≤ 0›
by (simp add: ivl_integral_def)
also have "... = norm (integral {s..0} (λs'. f (Y (x - x0) s')) -
integral {s..0} (λs'. f (flow0 x0 s')) -
integral {s..0} (λs'. vareq x0 s' (vector_Dflow (x - x0) s')))"
by (subst norm_minus_cancel[symmetric], simp)
finally show "?g s =
norm (integral {s..0} (λs'. f (Y (x - x0) s')) -
integral {s..0} (λs'. f (flow0 x0 s')) -
integral {s..0} (λs'. blinfun_apply (f' (flow0 x0 s')) (vector_Dflow (x - x0) s')))"
unfolding vareq_def .
qed
also have "... =
norm (integral {a..b} (λs. f (Y (x - x0) s) - f (flow0 x0 s) - (f' (flow0 x0 s)) (vector_Dflow (x - x0) s)))"
by (simp add: i1 i2)
also have "... ≤
integral {a..b} (λs. norm (f (Y (x - x0) s) - f (flow0 x0 s) - f' (flow0 x0 s) (vector_Dflow (x - x0) s)))"
using x_in_X J_in_existence_ivl_x J_in_existence ‹{a..b} ⊆ J›
by (auto intro!: continuous_intros continuous_on_imp_absolutely_integrable_on
existence_ivl_reverse)
also have "... = integral {a..b}
(λs. norm (f' (flow0 x0 s) (Y (x - x0) s - flow0 x0 s - vector_Dflow (x - x0) s) + R (flow0 x0 s) (Y (x - x0) s)))"
proof (safe intro!: integral_spike[OF negligible_empty, simplified] arg_cong[where f=norm])
fix s' assume "s' ∈ {a..b}"
show "f' (flow0 x0 s') (Y (x - x0) s' - flow0 x0 s' - vector_Dflow (x - x0) s') + R (flow0 x0 s') (Y (x - x0) s') =
f (Y (x - x0) s') - f (flow0 x0 s') - f' (flow0 x0 s') (vector_Dflow (x - x0) s')"
by (simp add: blinfun.diff_right Taylor_expansion(2)[of "flow0 x s'" "flow0 x0 s'"])
qed
also have "... ≤ integral {a..b}
(λs. norm (f' (flow0 x0 s) (Y (x - x0) s - flow0 x0 s - vector_Dflow (x - x0) s)) +
norm (R (flow0 x0 s) (Y (x - x0) s)))"
using J_in_existence_ivl[OF x_in_ball] norm_triangle_ineq
using ‹continuous_on J (λs. R (flow0 x0 s) (Y (x - x0) s))›
by (auto intro!: continuous_intros integral_le)
also have "... =
integral {a..b} (λs. norm (f' (flow0 x0 s) (Y (x - x0) s - flow0 x0 s - vector_Dflow (x - x0) s))) +
integral {a..b} (λs. norm (R (flow0 x0 s) (Y (x - x0) s)))"
using J_in_existence_ivl[OF x_in_ball]
using ‹continuous_on J (λs. R (flow0 x0 s) (Y (x - x0) s))›
by (auto intro!: continuous_intros Henstock_Kurzweil_Integration.integral_add)
also have "... ≤ N * integral {a..b} ?g + ?C" (is "?l1 + ?r1 ≤ _")
proof(rule add_mono)
have "?l1 ≤ integral {a..b} (λs. norm (f' (flow0 x0 s)) * norm (Y (x - x0) s - flow0 x0 s - vector_Dflow (x - x0) s))"
using norm_blinfun J_in_existence_ivl[OF x_in_ball]
by (auto intro!: continuous_intros integral_le)
also have "... ≤ integral {a..b} (λs. N * norm (Y (x - x0) s - flow0 x0 s - vector_Dflow (x - x0) s))"
using J_in_existence_ivl[OF x_in_ball] N_ineq[OF ‹{a..b} ⊆ J›[THEN subsetD]]
by (intro integral_le) (auto intro!: continuous_intros mult_right_mono)
also have "... = N * integral {a..b} (λs. norm ((Y (x - x0) s - flow0 x0 s - vector_Dflow (x - x0) s)))"
unfolding real_scaleR_def[symmetric]
by(rule integral_cmul)
finally show "?l1 ≤ N * integral {a..b} ?g" .
next
have "?r1 ≤ integral {a..b} (λs. e1 * dist (flow0 x0 s) (Y (x - x0) s))"
using J_in_existence_ivl[OF x_in_ball] ‹0 < e_domain› dist_flow0_Y2 ‹0 < e_domain2›
by (intro integral_le)
(force
intro!: continuous_intros Taylor_expansion(3) order_trans[OF infdist_le]
dest!: ‹{a..b} ⊆ J›[THEN subsetD]
intro: less_imp_le
simp: dist_commute H_def)+
also have "... ≤ integral {a..b} (λs. e1 * (dist x0 x * exp (K * ¦t¦)))"
apply(rule integral_le)
subgoal using J_in_existence_ivl[OF x_in_ball] by (force intro!: continuous_intros)
subgoal by force
subgoal by (force dest!: ‹{a..b} ⊆ J›[THEN subsetD]
intro!: less_imp_le[OF ‹0 < e1›] mult_left_mono[OF dist_flow0_Y])
done
also have "... ≤ ?C"
using ‹s ∈ J› x_x0_dist ‹0 < e1› ‹{a..b} ⊆ J› ‹0 < ¦t¦› t0_def t1_def
by (auto simp: integral_const_real J_def(1))
finally show "?r1 ≤ ?C" .
qed
finally show ?thesis
by simp
qed
have g_continuous: "continuous_on J ?g"
using J_in_existence_ivl[OF x_in_ball] J_in_existence
using J_def(1) U_continuous
by (auto simp: J_def intro!: continuous_intros)
note [continuous_intros] = continuous_on_subset[OF g_continuous]
have C_gr_zero: "0 < ?C"
using ‹0 < ¦t¦› ‹0 < e1› x_x0_dist(1)
by (simp add: dist_commute)
have "0 ≤ t ∨ t ≤ 0" by auto
then have "?g t ≤ ?C * exp (N * ¦t¦)"
proof
assume "0 ≤ t"
moreover
have "continuous_on {0..t} (vector_Dflow (x - x0))"
using U_continuous
by (rule continuous_on_subset) (auto simp: J_def t0_def t1_def)
then have "norm (Y (x - x0) t - flow0 x0 t - vector_Dflow (x - x0) t) ≤
¦t¦ * dist x0 x * exp (K * ¦t¦) * e1 * exp (N * t)"
using ‹t ∈ J› J_def ‹t0 ≤ 0› J_in_existence J_in_existence_ivl_x
by (intro gronwall[OF g_bound _ _ C_gr_zero ‹0 < N› ‹0 ≤ t› order.refl])
(auto intro!: continuous_intros simp: )
ultimately show ?thesis by simp
next
assume "t ≤ 0"
moreover
have "continuous_on {t .. 0} (vector_Dflow (x - x0))"
using U_continuous
by (rule continuous_on_subset) (auto simp: J_def t0_def t1_def)
then have "norm (Y (x - x0) t - flow0 x0 t - vector_Dflow (x - x0) t) ≤
¦t¦ * dist x0 x * exp (K * ¦t¦) * e1 * exp (- N * t)"
using ‹t ∈ J› J_def ‹0 ≤ t1› J_in_existence J_in_existence_ivl_x
by (intro gronwall_left[OF g_bound _ _ C_gr_zero ‹0 < N› order.refl ‹t ≤ 0›])
(auto intro!: continuous_intros)
ultimately show ?thesis
by simp
qed
also have "... = dist x x0 * (¦t¦ * exp (K * ¦t¦) * e1 * exp (N * ¦t¦))"
by (auto simp: dist_commute)
also have "... < norm (x - x0) * e"
unfolding e1_def
using ‹e' < e› ‹0 < ¦t¦› ‹0 < e1› x_x0_dist(1)
by (simp add: dist_norm)
finally show "norm ((Y (x - x0) t - flow0 x0 t - vector_Dflow (x - x0) t) /⇩R norm (x - x0)) < e"
by (simp, metis x_x0_dist(1) dist_norm divide_inverse mult.commute pos_divide_less_eq)
qed
qed
qed
qed
lemma local_lipschitz_A:
"OT ⊆ existence_ivl0 x0 ⟹ local_lipschitz OT (OS::('a ⇒⇩L 'a) set) (λt. (o⇩L) (vareq x0 t))"
by (rule local_lipschitz_subset[OF _ _ subset_UNIV, where T="existence_ivl0 x0"])
(auto simp: split_beta' vareq_def
intro!: c1_implies_local_lipschitz[where f'="λ(t, x). comp3 (f' (flow0 x0 t))"]
derivative_eq_intros blinfun_eqI ext
continuous_intros flow_in_domain)
lemma total_derivative_ll_on_open:
"ll_on_open (existence_ivl0 x0) (λt. blinfun_compose (vareq x0 t)) (UNIV::('a ⇒⇩L 'a) set)"
by standard (auto intro!: continuous_intros local_lipschitz_A[OF order_refl])
end
end
sublocale mvar: ll_on_open "existence_ivl0 x0" "λt. blinfun_compose (vareq x0 t)" "UNIV::('a ⇒⇩L 'a) set" for x0
by (rule total_derivative_ll_on_open)
lemma mvar_existence_ivl_eq_existence_ivl[simp]:
assumes "t ∈ existence_ivl0 x0"
shows "mvar.existence_ivl x0 t = (λ_. existence_ivl0 x0)"
proof (rule ext, rule mvar.existence_ivl_eq_domain)
fix s t x
assume s: "s ∈ existence_ivl0 x0" and t: "t ∈ existence_ivl0 x0"
then have "{s .. t} ⊆ existence_ivl0 x0"
by (meson atLeastAtMost_iff is_interval_1 is_interval_existence_ivl subsetI)
then have "continuous_on {s .. t} (vareq x0)"
by (auto intro!: continuous_intros)
then have "compact (vareq x0 ` {s .. t})"
using compact_Icc
by (rule compact_continuous_image)
then obtain B where B: "⋀u. u ∈ {s .. t} ⟹ norm (vareq x0 u) ≤ B"
by (force dest!: compact_imp_bounded simp: bounded_iff)
show "∃M L. ∀t∈{s .. t}. ∀x∈UNIV. norm (vareq x0 t o⇩L x) ≤ M + L * norm x"
unfolding o_def
by (rule exI[where x=0], rule exI[where x=B])
(auto intro!: order_trans[OF norm_blinfun_compose] mult_right_mono B)
qed (auto intro: assms)
lemma
assumes "t ∈ existence_ivl0 x0"
shows "continuous_on (UNIV × existence_ivl0 x0) (λ(x, ta). mvar.flow x0 t x ta)"
proof -
from mvar.flow_continuous_on_state_space[of x0 t, unfolded mvar_existence_ivl_eq_existence_ivl[OF assms]]
show "continuous_on (UNIV × existence_ivl0 x0) (λ(x, ta). mvar.flow x0 t x ta)" .
qed
definition "Dflow x0 = mvar.flow x0 0 id_blinfun"
lemma var_eq_mvar:
assumes "t0 ∈ existence_ivl0 x0"
assumes "t ∈ existence_ivl0 x0"
shows "var.flow x0 t0 i t = mvar.flow x0 t0 id_blinfun t i"
by (rule var.flow_unique)
(auto intro!: assms derivative_eq_intros mvar.flow_has_derivative
simp: varexivl_eq_exivl assms has_vector_derivative_def blinfun.bilinear_simps)
lemma Dflow_zero[simp]: "x ∈ X ⟹ Dflow x 0 = 1⇩L"
unfolding Dflow_def
by (subst mvar.flow_initial_time) auto
subsection ‹Differentiability of the flow0›
text ‹ ‹U t›, i.e. the solution of the variational equation, is the space derivative at the initial
value ‹x0›. ›
lemma flow_dx_derivative:
assumes "t ∈ existence_ivl0 x0"
shows "((λx0. flow0 x0 t) has_derivative (λz. vector_Dflow x0 z t)) (at x0)"
unfolding has_derivative_at2
using assms
by (intro iffD1[OF LIM_equal proposition_17_6_weak[OF assms]] conjI[OF bounded_linear_vector_Dflow[OF assms]])
(simp add: diff_diff_add inverse_eq_divide)
lemma flow_dx_derivative_blinfun:
assumes "t ∈ existence_ivl0 x0"
shows "((λx. flow0 x t) has_derivative Blinfun (λz. vector_Dflow x0 z t)) (at x0)"
by (rule has_derivative_Blinfun[OF flow_dx_derivative[OF assms]])
definition "flowderiv x0 t = comp12 (Dflow x0 t) (blinfun_scaleR_left (f (flow0 x0 t)))"
lemma flowderiv_eq: "flowderiv x0 t (ξ⇩1, ξ⇩2) = (Dflow x0 t) ξ⇩1 + ξ⇩2 *⇩R f (flow0 x0 t)"
by (auto simp: flowderiv_def)
lemma W_continuous_on: "continuous_on (Sigma X existence_ivl0) (λ(x0, t). Dflow x0 t)"
unfolding continuous_on split_beta'
proof (safe intro!: tendstoI)
fix e'::real and t x assume x: "x ∈ X" and tx: "t ∈ existence_ivl0 x" and e': "e' > 0"
let ?S = "Sigma X existence_ivl0"
have "(x, t) ∈ ?S" using x tx by auto
from open_prod_elim[OF open_state_space this]
obtain OX OT where OXOT: "open OX" "open OT" "(x, t) ∈ OX × OT" "OX × OT ⊆ ?S"
by blast
then obtain dx dt
where dx: "dx > 0" "cball x dx ⊆ OX"
and dt: "dt > 0" "cball t dt ⊆ OT"
by (force simp: open_contains_cball)
from OXOT dt dx have "cball t dt ⊆ existence_ivl0 x" "cball x dx ⊆ X"
apply (auto simp: subset_iff)
subgoal for ta
apply (drule spec[where x=ta])
apply (drule spec[where x=t])+
apply auto
done
done
have one_exivl: "mvar.existence_ivl x 0 = (λ_. existence_ivl0 x)"
by (rule mvar_existence_ivl_eq_existence_ivl[OF existence_ivl_zero[OF ‹x ∈ X›]])
have *: "closed ({t .. 0} ∪ {0 .. t})" "{t .. 0} ∪ {0 .. t} ≠ {}"
by auto
let ?T = "{t .. 0} ∪ {0 .. t} ∪ cball t dt"
have "compact ?T"
by (auto intro!: compact_Un)
have "?T ⊆ existence_ivl0 x"
by (intro Un_least ivl_subset_existence_ivl' ivl_subset_existence_ivl ‹x ∈ X›
‹t ∈ existence_ivl0 x› ‹cball t dt ⊆ existence_ivl0 x›)
have "compact (mvar.flow x 0 id_blinfun ` ?T)"
using ‹?T ⊆ _› ‹x ∈ X›
mvar_existence_ivl_eq_existence_ivl[OF existence_ivl_zero[OF ‹x ∈ X›]]
by (auto intro!: ‹0 < dx› compact_continuous_image ‹compact ?T›
continuous_on_subset[OF mvar.flow_continuous_on])
let ?line = "mvar.flow x 0 id_blinfun ` ?T"
let ?X = "{x. infdist x ?line ≤ dx}"
have "compact ?X"
using ‹?T ⊆ _› ‹x ∈ X›
mvar_existence_ivl_eq_existence_ivl[OF existence_ivl_zero[OF ‹x ∈ X›]]
by (auto intro!: compact_infdist_le ‹0 < dx› compact_continuous_image compact_Un
continuous_on_subset[OF mvar.flow_continuous_on ])
from mvar.local_lipschitz ‹?T ⊆ _›
have llc: "local_lipschitz ?T ?X (λt. (o⇩L) (vareq x t))"
by (rule local_lipschitz_subset) auto
have cont: "⋀xa. xa ∈ ?X ⟹ continuous_on ?T (λt. vareq x t o⇩L xa)"
using ‹?T ⊆ _›
by (auto intro!: continuous_intros ‹x ∈ X›)
from local_lipschitz_compact_implies_lipschitz[OF llc ‹compact ?X› ‹compact ?T› cont]
obtain K' where K': "⋀ta. ta ∈ ?T ⟹ K'-lipschitz_on ?X ((o⇩L) (vareq x ta))"
by blast
define K where "K ≡ abs K' + 1"
have "K > 0"
by (simp add: K_def)
have K: "⋀ta. ta ∈ ?T ⟹ K-lipschitz_on ?X ((o⇩L) (vareq x ta))"
by (auto intro!: lipschitz_onI mult_right_mono order_trans[OF lipschitz_onD[OF K']] simp: K_def)
have ex_ivlI: "⋀y. y ∈ cball x dx ⟹ ?T ⊆ existence_ivl0 y"
using dx dt OXOT
by (intro Un_least ivl_subset_existence_ivl' ivl_subset_existence_ivl; force)
have cont: "continuous_on ((?T × ?X) × cball x dx) (λ((ta, xa), y). (vareq y ta o⇩L xa))"
using ‹cball x dx ⊆ X› ex_ivlI
by (force intro!: continuous_intros simp: split_beta' )
have "mvar.flow x 0 id_blinfun t ∈ mvar.flow x 0 id_blinfun ` ({t..0} ∪ {0..t} ∪ cball t dt)"
by auto
then have mem: "(t, mvar.flow x 0 id_blinfun t, x) ∈ ?T × ?X × cball x dx"
by (auto simp: ‹0 < dx› less_imp_le)
define e where "e ≡ min e' (dx / 2) / 2"
have "e > 0" using ‹e' > 0› by (auto simp: e_def ‹0 < dx›)
define d where "d ≡ e * K / (exp (K * (abs t + abs dt + 1)) - 1)"
have "d > 0" by (auto simp: d_def intro!: mult_pos_pos divide_pos_pos ‹0 < e› ‹K > 0›)
have cmpct: "compact ((?T × ?X) × cball x dx)" "compact (?T × ?X)"
using ‹compact ?T› ‹compact ?X›
by (auto intro!: compact_cball compact_Times)
have compact_line: "compact ?line"
using ‹{t..0} ∪ {0..t} ∪ cball t dt ⊆ existence_ivl0 x› one_exivl
by (force intro!: compact_continuous_image ‹compact ?T› continuous_on_subset[OF mvar.flow_continuous_on] simp: ‹x ∈ X›)
from compact_uniformly_continuous[OF cont cmpct(1), unfolded uniformly_continuous_on_def,
rule_format, OF ‹0 < d›]
obtain d' where d': "d' > 0"
"⋀ta xa xa' y. ta ∈ ?T ⟹ xa ∈ ?X ⟹ xa'∈cball x dx ⟹ y∈cball x dx ⟹ dist xa' y < d' ⟹
dist (vareq xa' ta o⇩L xa) (vareq y ta o⇩L xa) < d"
by (auto simp: dist_prod_def)
{
fix y
assume dxy: "dist x y < d'"
assume "y ∈ cball x dx"
then have "y ∈ X"
using dx dt OXOT by force+
have two_exivl: "mvar.existence_ivl y 0 = (λ_. existence_ivl0 y)"
by (rule mvar_existence_ivl_eq_existence_ivl[OF existence_ivl_zero[OF ‹y ∈ X›]])
let ?X' = "⋃x ∈ ?line. ball x dx"
have "open ?X'" by auto
have "?X' ⊆ ?X"
by (auto intro!: infdist_le2 simp: dist_commute)
interpret oneR: ll_on_open "existence_ivl0 x" "(λt. (o⇩L) (vareq x t))" ?X'
by standard (auto intro!: ‹x ∈ X› continuous_intros local_lipschitz_A[OF order_refl])
interpret twoR: ll_on_open "existence_ivl0 y" "(λt. (o⇩L) (vareq y t))" ?X'
by standard (auto intro!: ‹y ∈ X› continuous_intros local_lipschitz_A[OF order_refl])
interpret both:
two_ll_on_open "(λt. (o⇩L) (vareq x t))" "existence_ivl0 x" "(λt. (o⇩L) (vareq y t))" "existence_ivl0 y" ?X' ?T "id_blinfun" d K
proof unfold_locales
show "0 < K" by (simp add: ‹0 < K›)
show iv_defined: "0 ∈ {t..0} ∪ {0..t} ∪ cball t dt"
by auto
show "is_interval ({t..0} ∪ {0..t} ∪ cball t dt)"
by (auto simp: is_interval_def dist_real_def)
show "{t..0} ∪ {0..t} ∪ cball t dt ⊆ oneR.existence_ivl 0 id_blinfun"
apply (rule oneR.maximal_existence_flow[where x="mvar.flow x 0 id_blinfun"])
subgoal
apply (rule solves_odeI)
apply (rule has_vderiv_on_subset[OF solves_odeD(1)[OF mvar.flow_solves_ode[of 0 x id_blinfun]]])
subgoal using ‹x ∈ X› ‹?T ⊆ _› ‹0 < dx› by simp
subgoal by simp
subgoal by (simp add: ‹cball t dt ⊆ existence_ivl0 x› ivl_subset_existence_ivl ivl_subset_existence_ivl' one_exivl tx)
subgoal using dx by (auto; force)
done
subgoal by (simp add: ‹x ∈ X›)
subgoal by fact
subgoal using iv_defined by blast
subgoal using ‹{t..0} ∪ {0..t} ∪ cball t dt ⊆ existence_ivl0 x› by blast
done
fix s assume s: "s ∈ ?T"
then show "K-lipschitz_on ?X' ((o⇩L) (vareq x s))"
by (intro lipschitz_on_subset[OF K ‹?X' ⊆ ?X›]) auto
fix j assume j: "j ∈ ?X'"
show "norm ((vareq x s o⇩L j) - (vareq y s o⇩L j)) < d"
unfolding dist_norm[symmetric]
apply (rule d')
subgoal by (rule s)
subgoal using ‹?X' ⊆ ?X› j ..
subgoal using ‹dx > 0› by simp
subgoal using ‹y ∈ cball x dx› by simp
subgoal using dxy by simp
done
qed
have less_e: "norm (Dflow x s - both.Y s) < e"
if s: "s ∈ ?T ∩ twoR.existence_ivl 0 id_blinfun" for s
proof -
from s have s_less: "¦s¦ < ¦t¦ + ¦dt¦ + 1"
by (auto simp: dist_real_def)
note both.norm_X_Y_bound[rule_format, OF s]
also have "d / K * (exp (K * ¦s¦) - 1) =
e * ((exp (K * ¦s¦) - 1) / (exp (K * (¦t¦ + ¦dt¦ + 1)) - 1))"
by (simp add: d_def)
also have "… < e * 1"
by (rule mult_strict_left_mono[OF _ ‹0 < e›])
(simp add: add_nonneg_pos ‹0 < K› ‹0 < e› s_less)
also have "… = e" by simp
also
from s have s: "s ∈ ?T" by simp
have "both.flow0 s = Dflow x s"
unfolding both.flow0_def Dflow_def
apply (rule oneR.maximal_existence_flow[where K="?T"])
subgoal
apply (rule solves_odeI)
apply (rule has_vderiv_on_subset[OF solves_odeD(1)[OF mvar.flow_solves_ode[of 0 x id_blinfun]]])
subgoal using ‹x ∈ X› ‹0 < dx› by simp
subgoal by simp
subgoal by (simp add: ‹cball t dt ⊆ existence_ivl0 x› ivl_subset_existence_ivl ivl_subset_existence_ivl' one_exivl tx)
subgoal using dx by (auto; force)
done
subgoal by (simp add: ‹x ∈ X›)
subgoal by (rule both.J_ivl)
subgoal using both.t0_in_J by blast
subgoal using ‹{t..0} ∪ {0..t} ∪ cball t dt ⊆ existence_ivl0 x› by blast
subgoal using s by blast
done
finally show ?thesis .
qed
have "e < dx" using ‹dx > 0› by (auto simp: e_def)
let ?i = "{y. infdist y (mvar.flow x 0 id_blinfun ` ?T) ≤ e}"
have 1: "?i ⊆ (⋃x∈mvar.flow x 0 id_blinfun ` ?T. ball x dx)"
proof -
have cl: "closed ?line" "?line ≠ {}" using compact_line
by (auto simp: compact_imp_closed)
have "?i ⊆ (⋃y∈mvar.flow x 0 id_blinfun ` ?T. cball y e)"
proof safe
fix x
assume H: "infdist x ?line ≤ e"
from infdist_attains_inf[OF cl, of x]
obtain y where "y ∈ ?line" "infdist x ?line = dist x y" by auto
then show "x ∈ (⋃x∈?line. cball x e)"
using H
by (auto simp: dist_commute)
qed
also have "… ⊆ (⋃x∈?line. ball x dx)"
using ‹e < dx›
by auto
finally show ?thesis .
qed
have 2: "twoR.flow 0 id_blinfun s ∈ ?i"
if "s ∈ ?T" "s ∈ twoR.existence_ivl 0 id_blinfun" for s
proof -
from that have sT: "s ∈ ?T ∩ twoR.existence_ivl 0 id_blinfun"
by force
from less_e[OF this]
have "dist (twoR.flow 0 id_blinfun s) (mvar.flow x 0 id_blinfun s) ≤ e"
unfolding Dflow_def both.Y_def dist_commute dist_norm by simp
then show ?thesis
using sT by (force intro: infdist_le2)
qed
have T_subset: "?T ⊆ twoR.existence_ivl 0 id_blinfun"
apply (rule twoR.subset_mem_compact_implies_subset_existence_interval[
where K="{x. infdist x ?line ≤ e}"])
subgoal using ‹0 < dt› by force
subgoal by (rule both.J_ivl)
subgoal using ‹y ∈ cball x dx› ex_ivlI by blast
subgoal using both.F_iv_defined(2) by blast
subgoal by (rule 2)
subgoal using ‹dt > 0› by (intro compact_infdist_le) (auto intro!: compact_line ‹0 < e›)
subgoal by (rule 1)
done
also have "twoR.existence_ivl 0 id_blinfun ⊆ existence_ivl0 y"
by (rule twoR.existence_ivl_subset)
finally have "?T ⊆ existence_ivl0 y" .
have "norm (Dflow x s - Dflow y s) < e" if s: "s ∈ ?T" for s
proof -
from s have "s ∈ ?T ∩ twoR.existence_ivl 0 id_blinfun" using T_subset by force
from less_e[OF this] have "norm (Dflow x s - both.Y s) < e" .
also have "mvar.flow y 0 id_blinfun s = twoR.flow 0 id_blinfun s"
apply (rule mvar.maximal_existence_flow[where K="?T"])
subgoal
apply (rule solves_odeI)
apply (rule has_vderiv_on_subset[OF solves_odeD(1)[OF twoR.flow_solves_ode[of 0 id_blinfun]]])
subgoal using ‹y ∈ X› by simp
subgoal using both.F_iv_defined(2) by blast
subgoal using T_subset by blast
subgoal by simp
done
subgoal using ‹y ∈ X› auto_ll_on_open.existence_ivl_zero auto_ll_on_open_axioms both.F_iv_defined(2) twoR.flow_initial_time by blast
subgoal by (rule both.J_ivl)
subgoal using both.t0_in_J by blast
subgoal using ‹{t..0} ∪ {0..t} ∪ cball t dt ⊆ existence_ivl0 y› by blast
subgoal using s by blast
done
then have "both.Y s = Dflow y s"
unfolding both.Y_def Dflow_def
by simp
finally show ?thesis .
qed
} note cont_data = this
have "∀⇩F (y, s) in at (x, t) within ?S. dist x y < d'"
unfolding at_within_open[OF ‹(x, t) ∈ ?S› open_state_space] UNIV_Times_UNIV[symmetric]
using ‹d' > 0›
by (intro eventually_at_Pair_within_TimesI1)
(auto simp: eventually_at less_imp_le dist_commute)
moreover
have "∀⇩F (y, s) in at (x, t) within ?S. y ∈ cball x dx"
unfolding at_within_open[OF ‹(x, t) ∈ ?S› open_state_space] UNIV_Times_UNIV[symmetric]
using ‹dx > 0›
by (intro eventually_at_Pair_within_TimesI1)
(auto simp: eventually_at less_imp_le dist_commute)
moreover
have "∀⇩F (y, s) in at (x, t) within ?S. s ∈ ?T"
unfolding at_within_open[OF ‹(x, t) ∈ ?S› open_state_space] UNIV_Times_UNIV[symmetric]
using ‹dt > 0›
by (intro eventually_at_Pair_within_TimesI2)
(auto simp: eventually_at less_imp_le dist_commute)
moreover
have "0 ∈ existence_ivl0 x" by (simp add: ‹x ∈ X›)
have "∀⇩F y in at t within existence_ivl0 x. dist (mvar.flow x 0 id_blinfun y) (mvar.flow x 0 id_blinfun t) < e"
using mvar.flow_continuous_on[of x 0 id_blinfun]
using ‹0 < e› tx
by (auto simp add: continuous_on one_exivl dest!: tendstoD)
then have "∀⇩F (y, s) in at (x, t) within ?S. dist (Dflow x s) (Dflow x t) < e"
using ‹0 < e›
unfolding at_within_open[OF ‹(x, t) ∈ ?S› open_state_space] UNIV_Times_UNIV[symmetric] Dflow_def
by (intro eventually_at_Pair_within_TimesI2)
(auto simp: at_within_open[OF tx open_existence_ivl])
ultimately
have "∀⇩F (y, s) in at (x, t) within ?S. dist (Dflow y s) (Dflow x t) < e'"
apply eventually_elim
proof (safe del: UnE, goal_cases)
case (1 y s)
have "dist (Dflow y s) (Dflow x t) ≤ dist (Dflow y s) (Dflow x s) + dist (Dflow x s) (Dflow x t)"
by (rule dist_triangle)
also
have "dist (Dflow x s) (Dflow x t) < e"
by (rule 1)
also have "dist (Dflow y s) (Dflow x s) < e"
unfolding dist_norm norm_minus_commute
using 1
by (intro cont_data)
also have "e + e ≤ e'" by (simp add: e_def)
finally show "dist (Dflow y s) (Dflow x t) < e'" by arith
qed
then show "∀⇩F ys in at (x, t) within ?S. dist (Dflow (fst ys) (snd ys)) (Dflow (fst (x, t)) (snd (x, t))) < e'"
by (simp add: split_beta')
qed
lemma W_continuous_on_comp[continuous_intros]:
assumes h: "continuous_on S h" and g: "continuous_on S g"
shows "(⋀s. s ∈ S ⟹ h s ∈ X) ⟹ (⋀s. s ∈ S ⟹ g s ∈ existence_ivl0 (h s)) ⟹
continuous_on S (λs. Dflow (h s) (g s))"
using continuous_on_compose[OF continuous_on_Pair[OF h g] continuous_on_subset[OF W_continuous_on]]
by auto
lemma f_flow_continuous_on: "continuous_on (Sigma X existence_ivl0) (λ(x0, t). f (flow0 x0 t))"
using flow_continuous_on_state_space
by (auto intro!: continuous_on_f flow_in_domain simp: split_beta')
lemma
flow_has_space_derivative:
assumes "t ∈ existence_ivl0 x0"
shows "((λx0. flow0 x0 t) has_derivative Dflow x0 t) (at x0)"
by (rule flow_dx_derivative_blinfun[THEN has_derivative_eq_rhs])
(simp_all add: var_eq_mvar assms blinfun.blinfun_apply_inverse Dflow_def vector_Dflow_def
mem_existence_ivl_iv_defined[OF assms])
lemma
flow_has_flowderiv:
assumes "t ∈ existence_ivl0 x0"
shows "((λ(x0, t). flow0 x0 t) has_derivative flowderiv x0 t) (at (x0, t) within S)"
proof -
have Sigma: "(x0, t) ∈ Sigma X existence_ivl0"
using assms by auto
from open_state_space assms obtain e' where e': "e' > 0" "ball (x0, t) e' ⊆ Sigma X existence_ivl0"
by (force simp: open_contains_ball)
define e where "e = e' / sqrt 2"
have "0 < e" using e' by (auto simp: e_def)
have "ball x0 e × ball t e ⊆ ball (x0, t) e'"
by (auto simp: dist_prod_def real_sqrt_sum_squares_less e_def)
also note e'(2)
finally have subs: "ball x0 e × ball t e ⊆ Sigma X existence_ivl0" .
have d1: "((λx0. flow0 x0 s) has_derivative blinfun_apply (Dflow y s)) (at y within ball x0 e)"
if "y ∈ ball x0 e" "s ∈ ball t e" for y s
using subs that
by (subst at_within_open; force intro!: flow_has_space_derivative)
have d2: "(flow0 y has_derivative blinfun_apply (blinfun_scaleR_left (f (flow0 y s)))) (at s within ball t e)"
if "y ∈ ball x0 e" "s ∈ ball t e" for y s
using subs that
unfolding has_vector_derivative_eq_has_derivative_blinfun[symmetric]
by (subst at_within_open; force intro!: flow_has_vector_derivative)
have "((λ(x0, t). flow0 x0 t) has_derivative flowderiv x0 t) (at (x0, t) within ball x0 e × ball t e)"
using subs
unfolding UNIV_Times_UNIV[symmetric]
by (intro has_derivative_partialsI[OF d1 d2, THEN has_derivative_eq_rhs])
(auto intro!: ‹0 < e› continuous_intros flow_in_domain
continuous_on_imp_continuous_within[where s="Sigma X existence_ivl0"]
assms
simp: flowderiv_def split_beta' flow0_defined assms mem_ball)
then have "((λ(x0, t). flow0 x0 t) has_derivative flowderiv x0 t) (at (x0, t) within Sigma X existence_ivl0)"
by (auto simp: at_within_open[OF _ open_state_space] at_within_open[OF _ open_Times] assms ‹0 < e›
mem_existence_ivl_iv_defined[OF assms])
then show ?thesis unfolding at_within_open[OF Sigma open_state_space]
by (rule has_derivative_at_withinI)
qed
lemma flow0_comp_has_derivative:
assumes h: "h s ∈ existence_ivl0 (g s)"
assumes [derivative_intros]: "(g has_derivative g') (at s within S)"
assumes [derivative_intros]: "(h has_derivative h') (at s within S)"
shows "((λx. flow0 (g x) (h x)) has_derivative (λx. blinfun_apply (flowderiv (g s) (h s)) (g' x, h' x)))
(at s within S)"
by (rule has_derivative_compose[where f="λx. (g x, h x)" and s=S,
OF _ flow_has_flowderiv[OF h], simplified])
(auto intro!: derivative_eq_intros)
lemma flowderiv_continuous_on: "continuous_on (Sigma X existence_ivl0) (λ(x0, t). flowderiv x0 t)"
unfolding flowderiv_def split_beta'
by (subst blinfun_of_matrix_works[where f="comp12 (Dflow (fst x) (snd x))
(blinfun_scaleR_left (f (flow0 (fst x) (snd x))))" for x, symmetric])
(auto intro!: continuous_intros flow_in_domain)
lemma flowderiv_continuous_on_comp[continuous_intros]:
assumes "continuous_on S x"
assumes "continuous_on S t"
assumes "⋀s. s ∈ S ⟹ x s ∈ X" "⋀s. s ∈ S ⟹ t s ∈ existence_ivl0 (x s)"
shows "continuous_on S (λxa. flowderiv (x xa) (t xa))"
by (rule continuous_on_compose2[OF flowderiv_continuous_on, where f="λs. (x s, t s)",
unfolded split_beta' fst_conv snd_conv])
(auto intro!: continuous_intros assms)
lemmas [intro] = flow_in_domain
lemma vareq_trans: "t0 ∈ existence_ivl0 x0 ⟹ t ∈ existence_ivl0 (flow0 x0 t0) ⟹
vareq (flow0 x0 t0) t = vareq x0 (t0 + t)"
by (auto simp: vareq_def flow_trans)
lemma diff_existence_ivl_trans:
"t0 ∈ existence_ivl0 x0 ⟹ t ∈ existence_ivl0 x0 ⟹ t - t0 ∈ existence_ivl0 (flow0 x0 t0)" for t
by (metis (no_types, hide_lams) add.left_neutral diff_add_eq
local.existence_ivl_reverse local.existence_ivl_trans local.flows_reverse)
lemma has_vderiv_on_blinfun_compose_right[derivative_intros]:
assumes "(g has_vderiv_on g') T"
assumes "⋀x. x ∈ T ⟹ gd' x = g' x o⇩L d"
shows "((λx. g x o⇩L d) has_vderiv_on gd') T"
using assms
by (auto simp: has_vderiv_on_def has_vector_derivative_def blinfun_ext blinfun.bilinear_simps
intro!: derivative_eq_intros ext)
lemma has_vderiv_on_blinfun_compose_left[derivative_intros]:
assumes "(g has_vderiv_on g') T"
assumes "⋀x. x ∈ T ⟹ gd' x = d o⇩L g' x"
shows "((λx. d o⇩L g x) has_vderiv_on gd') T"
using assms
by (auto simp: has_vderiv_on_def has_vector_derivative_def blinfun_ext blinfun.bilinear_simps
intro!: derivative_eq_intros ext)
lemma mvar_flow_shift:
assumes "t0 ∈ existence_ivl0 x0" "t1 ∈ existence_ivl0 x0"
shows "mvar.flow x0 t0 d t1 = Dflow (flow0 x0 t0) (t1 - t0) o⇩L d"
proof -
have "mvar.flow x0 t0 d t1 = mvar.flow x0 t0 d (t0 + (t1 - t0))"
by simp
also have "… = mvar.flow x0 t0 (mvar.flow x0 t0 d t0) t1"
by (subst mvar.flow_trans) (auto simp add: assms)
also have "… = Dflow (flow0 x0 t0) (t1 - t0) o⇩L d"
apply (rule mvar.flow_unique_on)
apply (auto simp add: assms mvar.flow_initial_time_if blinfun_ext Dflow_def
intro!: derivative_intros derivative_eq_intros)
apply (auto simp: assms has_vderiv_on_open has_vector_derivative_def
intro!: derivative_eq_intros blinfun_eqI)
apply (subst mvar_existence_ivl_eq_existence_ivl)
by (auto simp add: vareq_trans assms diff_existence_ivl_trans)
finally show ?thesis .
qed
lemma Dflow_trans:
assumes "h ∈ existence_ivl0 x0"
assumes "i ∈ existence_ivl0 (flow0 x0 h)"
shows "Dflow x0 (h + i) = Dflow (flow0 x0 h) i o⇩L (Dflow x0 h)"
proof -
have [intro, simp]: "h + i ∈ existence_ivl0 x0" "i + h ∈ existence_ivl0 x0" "x0 ∈ X"
using assms
by (auto simp add: add.commute existence_ivl_trans)
show ?thesis
unfolding Dflow_def
apply (subst mvar.flow_trans[where s=h and t=i])
subgoal by (auto simp: assms)
subgoal by (auto simp: assms)
by (subst mvar_flow_shift) (auto simp: assms Dflow_def )
qed
lemma Dflow_trans_apply:
assumes "h ∈ existence_ivl0 x0"
assumes "i ∈ existence_ivl0 (flow0 x0 h)"
shows "Dflow x0 (h + i) d0 = Dflow (flow0 x0 h) i (Dflow x0 h d0)"
proof -
have [intro, simp]: "h + i ∈ existence_ivl0 x0" "i + h ∈ existence_ivl0 x0" "x0 ∈ X"
using assms
by (auto simp add: add.commute existence_ivl_trans)
show ?thesis
unfolding Dflow_def
apply (subst mvar.flow_trans[where s=h and t=i])
subgoal by (auto simp: assms)
subgoal by (auto simp: assms)
by (subst mvar_flow_shift) (auto simp: assms Dflow_def )
qed
end
end
Theory Upper_Lower_Solution
section ‹Upper and Lower Solutions›
theory Upper_Lower_Solution
imports Flow
begin
text ‹Following Walter~\cite{walter} in section 9›
lemma IVT_min:
fixes f :: "real ⇒ 'b :: {linorder_topology,real_normed_vector,ordered_real_vector}"
assumes y: "f a ≤ y" "y ≤ f b" "a ≤ b"
assumes *: "continuous_on {a .. b} f"
notes [continuous_intros] = *[THEN continuous_on_subset]
obtains x where "a ≤ x" "x ≤ b" "f x = y" "⋀x'. a ≤ x' ⟹ x' < x ⟹ f x' < y"
proof -
let ?s = "((λx. f x - y) -` {0..}) ∩ {a..b}"
have "?s ≠ {}"
using assms
by auto
have "closed ?s"
by (rule closed_vimage_Int) (auto intro!: continuous_intros)
moreover have "bounded ?s"
by (rule bounded_Int) (simp add: bounded_closed_interval)
ultimately have "compact ?s"
using compact_eq_bounded_closed by blast
from compact_attains_inf[OF this ‹?s ≠ {}›]
obtain x where x: "a ≤ x" "x ≤ b" "f x ≥ y"
and min: "⋀z. a ≤ z ⟹ z ≤ b ⟹ f z ≥ y ⟹ x ≤ z"
by auto
have "f x ≤ y"
proof (rule ccontr)
assume n: "¬ f x ≤ y"
then have "∃z≥a. z ≤ x ∧ (λx. f x - y) z = 0"
using x by (intro IVT') (auto intro!: continuous_intros simp: assms)
then obtain z where z: "a ≤ z" "z ≤ x" "f z = y" by auto
then have "a ≤ z" "z ≤ b" "f z ≥ y" using x by auto
from min [OF this] z n
show False by auto
qed
then have "a ≤ x" "x ≤ b" "f x = y"
using x
by (auto )
moreover have "f x' < y" if "a ≤ x'" "x' < x" for x'
apply (rule ccontr)
using min[of x'] that x
by (auto simp: not_less)
ultimately show ?thesis ..
qed
lemma filtermap_at_left_shift: "filtermap (λx. x - d) (at_left a) = at_left (a - d::real)"
by (simp add: filter_eq_iff eventually_filtermap eventually_at_filter filtermap_nhds_shift[symmetric])
context
fixes v v' w w'::"real ⇒ real" and t0 t1 e::real
assumes v': "(v has_vderiv_on v') {t0 <.. t1}"
and w': "(w has_vderiv_on w') {t0 <.. t1}"
assumes pos_ivl: "t0 < t1"
assumes e_pos: "e > 0" and e_in: "t0 + e ≤ t1"
assumes less: "⋀t. t0 < t ⟹ t < t0 + e ⟹ v t < w t"
begin
lemma first_intersection_crossing_derivatives:
assumes na: "t0 < tg" "tg ≤ t1" "v tg ≥ w tg"
notes [continuous_intros] =
vderiv_on_continuous_on[OF v', THEN continuous_on_subset]
vderiv_on_continuous_on[OF w', THEN continuous_on_subset]
obtains x0 where
"t0 < x0" "x0 ≤ tg"
"v' x0 ≥ w' x0"
"v x0 = w x0"
"⋀t. t0 < t ⟹ t < x0 ⟹ v t < w t"
proof -
have "(v - w) (min tg (t0 + e / 2)) ≤ 0" "0 ≤ (v - w) tg"
"min tg (t0 + e / 2) ≤ tg"
"continuous_on {min tg (t0 + e / 2)..tg} (v - w)"
using less[of "t0 + e / 2"]
less[of tg]na ‹e > 0›
by (auto simp: min_def intro!: continuous_intros)
from IVT_min[OF this]
obtain x0 where x0: "min tg (t0 + e / 2) ≤ x0" "x0 ≤ tg" "v x0 = w x0"
"⋀x'. min tg (t0 + e / 2) ≤ x' ⟹ x' < x0 ⟹ v x' < w x'"
by auto
then have x0_in: "t0 < x0" "x0 ≤ t1"
using ‹e > 0› na(1,2)
by (auto)
note ‹t0 < x0› ‹x0 ≤ tg›
moreover
{
from v' x0_in
have "(v has_derivative (λx. x * v' x0)) (at x0 within {t0<..<x0})"
by (force intro: has_derivative_subset simp: has_vector_derivative_def has_vderiv_on_def)
then have v: "((λy. (v y - (v x0 + (y - x0) * v' x0)) / norm (y - x0)) ⤏ 0) (at x0 within {t0<..<x0})"
unfolding has_derivative_within
by (simp add: ac_simps)
from w' x0_in
have "(w has_derivative (λx. x * w' x0)) (at x0 within {t0<..<x0})"
by (force intro: has_derivative_subset simp: has_vector_derivative_def has_vderiv_on_def)
then have w: "((λy. (w y - (w x0 + (y - x0) * w' x0)) / norm (y - x0)) ⤏ 0) (at x0 within {t0<..<x0})"
unfolding has_derivative_within
by (simp add: ac_simps)
have evs: "∀⇩F x in at x0 within {t0<..<x0}. min tg (t0 + e / 2) < x"
"∀⇩F x in at x0 within {t0<..<x0}. t0 < x ∧ x < x0"
using less na(1) na(3) x0(3) x0_in(1)
by (force simp: min_def eventually_at_filter intro!: order_tendstoD[OF tendsto_ident_at])+
then have "∀⇩F x in at x0 within {t0<..<x0}.
(v x - (v x0 + (x - x0) * v' x0)) / norm (x - x0) - (w x - (w x0 + (x - x0) * w' x0)) / norm (x - x0) =
(v x - w x) / norm (x - x0) + (v' x0 - w' x0)"
apply eventually_elim
using x0_in x0 less na ‹t0 < t1› sum_sqs_eq
by (auto simp: divide_simps algebra_simps min_def intro!: eventuallyI split: if_split_asm)
from this tendsto_diff[OF v w]
have 1: "((λx. (v x - w x) / norm (x - x0) + (v' x0 - w' x0)) ⤏ 0) (at x0 within {t0<..<x0})"
by (force intro: tendsto_eq_rhs Lim_transform_eventually)
moreover
from evs have 2: "∀⇩F x in at x0 within {t0<..<x0}. (v x - w x) / norm (x - x0) + (v' x0 - w' x0) ≤ (v' x0 - w' x0)"
by eventually_elim (auto simp: divide_simps intro!: less_imp_le x0(4))
moreover
have "at x0 within {t0<..<x0} ≠ bot"
by (simp add: ‹t0 < x0› at_within_eq_bot_iff less_imp_le)
ultimately
have "0 ≤ v' x0 - w' x0"
by (rule tendsto_upperbound)
then have "v' x0 ≥ w' x0" by simp
}
moreover note ‹v x0 = w x0›
moreover
have "t0 < t ⟹ t < x0 ⟹ v t < w t" for t
by (cases "min tg (t0 + e / 2) ≤ t") (auto intro: x0 less)
ultimately show ?thesis ..
qed
lemma defect_less:
assumes b: "⋀t. t0 < t ⟹ t ≤ t1 ⟹ v' t - f t (v t) < w' t - f t (w t)"
notes [continuous_intros] =
vderiv_on_continuous_on[OF v', THEN continuous_on_subset]
vderiv_on_continuous_on[OF w', THEN continuous_on_subset]
shows "∀t ∈ {t0 <.. t1}. v t < w t"
proof (rule ccontr)
assume " ¬ (∀t∈{t0 <.. t1}. v t < w t)"
then obtain tu where "t0 < tu" "tu ≤ t1" "v tu ≥ w tu" by auto
from first_intersection_crossing_derivatives[OF this]
obtain x0 where "t0 < x0" "x0 ≤ tu" "w' x0 ≤ v' x0" "v x0 = w x0" "⋀t. t0 < t ⟹ t < x0 ⟹ v t < w t"
by metis
with b[of x0] ‹tu ≤ t1›
show False
by simp
qed
end
lemma has_derivatives_less_lemma:
fixes v v' ::"real ⇒ real"
assumes v': "(v has_vderiv_on v') T"
assumes y': "(y has_vderiv_on y') T"
assumes lu: "⋀t. t ∈ T ⟹ t > t0 ⟹ v' t - f t (v t) < y' t - f t (y t)"
assumes lower: "v t0 ≤ y t0"
assumes eq_imp: "v t0 = y t0 ⟹ v' t0 < y' t0"
assumes t: "t0 < t" "t0 ∈ T" "t ∈ T" "is_interval T"
shows "v t < y t"
proof -
have subset: "{t0 .. t} ⊆ T"
by (rule atMostAtLeast_subset_convex) (auto simp: assms is_interval_convex)
obtain d where "0 < d" "t0 < s ⟹ s ≤ t ⟹ s < t0 + d ⟹ v s < y s" for s
proof cases
assume "v t0 = y t0"
from this[THEN eq_imp]
have *: "0 < y' t0 - v' t0"
by (simp add: )
have "((λt. y t - v t) has_vderiv_on (λt0. y' t0 - v' t0)) {t0 .. t}"
by (auto intro!: derivative_intros y' v' has_vderiv_on_subset[OF _ subset])
with ‹t0 < t›
have d: "((λt. y t - v t) has_real_derivative y' t0 - v' t0) (at t0 within {t0 .. t})"
by (auto simp: has_vderiv_on_def has_field_derivative_iff_has_vector_derivative)
from has_real_derivative_pos_inc_right[OF d *] ‹v t0 = y t0›
obtain d where "d > 0" and vy: "h > 0 ⟹ t0 + h ≤ t ⟹ h < d ⟹ v (t0 + h) < y (t0 + h)" for h
by auto
have vy: "t0 < s ⟹ s ≤ t ⟹ s < t0 + d ⟹ v s < y s" for s
using vy[of "s - t0"] by simp
with ‹d > 0› show ?thesis ..
next
assume "v t0 ≠ y t0"
then have "v t0 < y t0" using lower by simp
moreover
have "continuous_on {t0 .. t} v" "continuous_on {t0 .. t} y"
by (auto intro!: vderiv_on_continuous_on assms has_vderiv_on_subset[OF _ subset])
then have "(v ⤏ v t0) (at t0 within {t0 .. t})" "(y ⤏ y t0) (at t0 within {t0 .. t})"
by (auto simp: continuous_on)
ultimately have "∀⇩F x in at t0 within {t0 .. t}. 0 < y x - v x"
by (intro order_tendstoD) (auto intro!: tendsto_eq_intros)
then obtain d where "d > 0" "⋀x. t0 < x ⟹ x ≤ t ⟹ x < t0 + d ⟹ v x < y x"
by atomize_elim (auto simp: eventually_at algebra_simps dist_real_def)
then show ?thesis ..
qed
with ‹d > 0› ‹t0 < t›
obtain e where "e > 0" "t0 + e ≤ t" "t0 < s ⟹ s < t0 + e ⟹ v s < y s" for s
by atomize_elim (auto simp: min_def divide_simps intro!: exI[where x="min (d/2) ((t - t0) / 2)"]
split: if_split_asm)
from defect_less[
OF has_vderiv_on_subset[OF v']
has_vderiv_on_subset[OF y']
‹t0 < t›
this lu]
show "v t < y t" using ‹t0 < t› subset
by (auto simp: subset_iff assms)
qed
lemma strict_lower_solution:
fixes v v' ::"real ⇒ real"
assumes sol: "(y solves_ode f) T X"
assumes v': "(v has_vderiv_on v') T"
assumes lower: "⋀t. t ∈ T ⟹ t > t0 ⟹ v' t < f t (v t)"
assumes iv: "v t0 ≤ y t0" "v t0 = y t0 ⟹ v' t0 < f t0 (y t0)"
assumes t: "t0 < t" "t0 ∈ T" "t ∈ T" "is_interval T"
shows "v t < y t"
proof -
note v'
moreover
note solves_odeD(1)[OF sol]
moreover
have 3: "v' t - f t (v t) < f t (y t) - f t (y t)" if "t ∈ T" "t > t0" for t
using lower(1)[OF that]
by arith
moreover note iv
moreover note t
ultimately
show "v t < y t"
by (rule has_derivatives_less_lemma)
qed
lemma strict_upper_solution:
fixes w w'::"real ⇒ real"
assumes sol: "(y solves_ode f) T X"
assumes w': "(w has_vderiv_on w') T"
and upper: "⋀t. t ∈ T ⟹ t > t0 ⟹ f t (w t) < w' t"
and iv: "y t0 ≤ w t0" "y t0 = w t0 ⟹ f t0 (y t0) < w' t0"
assumes t: "t0 < t" "t0 ∈ T" "t ∈ T" "is_interval T"
shows "y t < w t"
proof -
note solves_odeD(1)[OF sol]
moreover
note w'
moreover
have "f t (y t) - f t (y t) < w' t - f t (w t)" if "t ∈ T" "t > t0" for t
using upper(1)[OF that]
by arith
moreover note iv
moreover note t
ultimately
show "y t < w t"
by (rule has_derivatives_less_lemma)
qed
lemma uniform_limit_at_within_subset:
assumes "uniform_limit S x l (at t within T)"
assumes "U ⊆ T"
shows "uniform_limit S x l (at t within U)"
by (metis assms(1) assms(2) eventually_within_Un filterlim_iff subset_Un_eq)
lemma uniform_limit_le:
fixes f::"'c ⇒ 'a ⇒ 'b::{metric_space, linorder_topology}"
assumes I: "I ≠ bot"
assumes u: "uniform_limit X f g I"
assumes u': "uniform_limit X f' g' I"
assumes "∀⇩F i in I. ∀x ∈ X. f i x ≤ f' i x"
assumes "x ∈ X"
shows "g x ≤ g' x"
proof -
have "∀⇩F i in I. f i x ≤ f' i x" using assms by (simp add: eventually_mono)
with I tendsto_uniform_limitI[OF u' ‹x ∈ X›] tendsto_uniform_limitI[OF u ‹x ∈ X›]
show ?thesis by (rule tendsto_le)
qed
lemma uniform_limit_le_const:
fixes f::"'c ⇒ 'a ⇒ 'b::{metric_space, linorder_topology}"
assumes I: "I ≠ bot"
assumes u: "uniform_limit X f g I"
assumes "∀⇩F i in I. ∀x ∈ X. f i x ≤ h x"
assumes "x ∈ X"
shows "g x ≤ h x"
proof -
have "∀⇩F i in I. f i x ≤ h x" using assms by (simp add: eventually_mono)
then show ?thesis by (metis tendsto_upperbound I tendsto_uniform_limitI[OF u ‹x ∈ X›])
qed
lemma uniform_limit_ge_const:
fixes f::"'c ⇒ 'a ⇒ 'b::{metric_space, linorder_topology}"
assumes I: "I ≠ bot"
assumes u: "uniform_limit X f g I"
assumes "∀⇩F i in I. ∀x ∈ X. h x ≤ f i x"
assumes "x ∈ X"
shows "h x ≤ g x"
proof -
have "∀⇩F i in I. h x ≤ f i x" using assms by (simp add: eventually_mono)
then show ?thesis by (metis tendsto_lowerbound I tendsto_uniform_limitI[OF u ‹x ∈ X›])
qed
locale ll_on_open_real = ll_on_open T f X for T f and X::"real set"
begin
lemma lower_solution:
fixes v v' ::"real ⇒ real"
assumes sol: "(y solves_ode f) S X"
assumes v': "(v has_vderiv_on v') S"
assumes lower: "⋀t. t ∈ S ⟹ t > t0 ⟹ v' t < f t (v t)"
assumes iv: "v t0 ≤ y t0"
assumes t: "t0 ≤ t" "t0 ∈ S" "t ∈ S" "is_interval S" "S ⊆ T"
shows "v t ≤ y t"
proof cases
assume "v t0 = y t0"
have "{t0 -- t} ⊆ S" using t by (simp add: closed_segment_subset is_interval_convex)
with sol have "(y solves_ode f) {t0 -- t} X" using order_refl by (rule solves_ode_on_subset)
moreover note refl
moreover
have "{t0 -- t} ⊆ T" using ‹{t0 -- t} ⊆ S› ‹S ⊆ T› by (rule order_trans)
ultimately have t_ex: "t ∈ existence_ivl t0 (y t0)"
by (rule existence_ivl_maximal_segment)
have t0_ex: "t0 ∈ existence_ivl t0 (y t0)"
using in_existence_between_zeroI t_ex by blast
have "t0 ∈ T" using assms(9) t(2) by blast
from uniform_limit_flow[OF t0_ex t_ex] ‹t0 ≤ t›
have "uniform_limit {t0..t} (flow t0) (flow t0 (y t0)) (at (y t0))" by simp
then have "uniform_limit {t0..t} (flow t0) (flow t0 (y t0)) (at_right (y t0))"
by (rule uniform_limit_at_within_subset) simp
moreover
{
have "∀⇩F i in at (y t0). t ∈ existence_ivl t0 i"
by (rule eventually_mem_existence_ivl) fact
then have "∀⇩F i in at_right (y t0). t ∈ existence_ivl t0 i"
unfolding eventually_at_filter
by eventually_elim simp
moreover have "∀⇩F i in at_right (y t0). i ∈ X"
proof -
have f1: "⋀r ra rb. r ∉ existence_ivl ra rb ∨ rb ∈ X"
by (metis existence_ivl_reverse flow_in_domain flows_reverse)
obtain rr :: "(real ⇒ bool) ⇒ (real ⇒ bool) ⇒ real" where
"⋀p f pa fa. (¬ eventually p f ∨ eventually pa f ∨ p (rr p pa)) ∧
(¬ eventually p fa ∨ ¬ pa (rr p pa) ∨ eventually pa fa)"
by (metis (no_types) eventually_mono)
then show ?thesis
using f1 calculation by meson
qed
moreover have "∀⇩F i in at_right (y t0). y t0 < i"
by (simp add: eventually_at_filter)
ultimately have "∀⇩F i in at_right (y t0). ∀x∈{t0..t}. v x ≤ flow t0 i x"
proof eventually_elim
case (elim y')
show ?case
proof safe
fix s assume s: "s ∈ {t0..t}"
show "v s ≤ flow t0 y' s"
proof cases
assume "s = t0" with elim iv show ?thesis
by (simp add: ‹t0 ∈ T› ‹y' ∈ X›)
next
assume "s ≠ t0" with s have "t0 < s" by simp
have "{t0 -- s} ⊆ S" using ‹{t0--t} ⊆ S› closed_segment_eq_real_ivl s by auto
from s elim have "{t0..s} ⊆ existence_ivl t0 y'"
using ivl_subset_existence_ivl by blast
with flow_solves_ode have sol: "(flow t0 y' solves_ode f) {t0 .. s} X"
by (rule solves_ode_on_subset) (auto intro!: ‹y' ∈ X› ‹t0 ∈ T›)
have "{t0 .. s} ⊆ S" using ‹{t0 -- s} ⊆ S› by (simp add: closed_segment_eq_real_ivl split: if_splits)
with v' have v': "(v has_vderiv_on v') {t0 .. s}"
by (rule has_vderiv_on_subset)
from ‹y t0 < y'› ‹v t0 = y t0› have less_init: "v t0 < flow t0 y' t0"
by (simp add: flow_initial_time_if ‹t0 ∈ T› ‹y' ∈ X›)
from strict_lower_solution[OF sol v' lower less_imp_le[OF less_init] _ ‹t0 < s›]
‹{t0 .. s} ⊆ S›
less_init ‹t0 < s›
have "v s < flow t0 y' s" by (simp add: subset_iff is_interval_cc)
then show ?thesis by simp
qed
qed
qed
}
moreover have "t ∈ {t0 .. t}" using ‹t0 ≤ t› by simp
ultimately have "v t ≤ flow t0 (y t0) t"
by (rule uniform_limit_ge_const[OF trivial_limit_at_right_real])
also have "flow t0 (y t0) t = y t"
using sol t
by (intro maximal_existence_flow) auto
finally show ?thesis .
next
assume "v t0 ≠ y t0" then have less: "v t0 < y t0" using iv by simp
show ?thesis
apply (cases "t0 = t")
subgoal using iv by blast
subgoal using strict_lower_solution[OF sol v' lower iv] less t by force
done
qed
lemma upper_solution:
fixes v v' ::"real ⇒ real"
assumes sol: "(y solves_ode f) S X"
assumes v': "(v has_vderiv_on v') S"
assumes upper: "⋀t. t ∈ S ⟹ t > t0 ⟹ f t (v t) < v' t"
assumes iv: "y t0 ≤ v t0"
assumes t: "t0 ≤ t" "t0 ∈ S" "t ∈ S" "is_interval S" "S ⊆ T"
shows "y t ≤ v t"
proof cases
assume "v t0 = y t0"
have "{t0 -- t} ⊆ S" using t by (simp add: closed_segment_subset is_interval_convex)
with sol have "(y solves_ode f) {t0 -- t} X" using order_refl by (rule solves_ode_on_subset)
moreover note refl
moreover
have "{t0 -- t} ⊆ T" using ‹{t0 -- t} ⊆ S› ‹S ⊆ T› by (rule order_trans)
ultimately have t_ex: "t ∈ existence_ivl t0 (y t0)"
by (rule existence_ivl_maximal_segment)
have t0_ex: "t0 ∈ existence_ivl t0 (y t0)"
using in_existence_between_zeroI t_ex by blast
have "t0 ∈ T" using assms(9) t(2) by blast
from uniform_limit_flow[OF t0_ex t_ex] ‹t0 ≤ t›
have "uniform_limit {t0..t} (flow t0) (flow t0 (y t0)) (at (y t0))" by simp
then have "uniform_limit {t0..t} (flow t0) (flow t0 (y t0)) (at_left (y t0))"
by (rule uniform_limit_at_within_subset) simp
moreover
{
have "∀⇩F i in at (y t0). t ∈ existence_ivl t0 i"
by (rule eventually_mem_existence_ivl) fact
then have "∀⇩F i in at_left (y t0). t ∈ existence_ivl t0 i"
unfolding eventually_at_filter
by eventually_elim simp
moreover have "∀⇩F i in at_left (y t0). i ∈ X"
proof -
have f1: "⋀r ra rb. r ∉ existence_ivl ra rb ∨ rb ∈ X"
by (metis existence_ivl_reverse flow_in_domain flows_reverse)
obtain rr :: "(real ⇒ bool) ⇒ (real ⇒ bool) ⇒ real" where
"⋀p f pa fa. (¬ eventually p f ∨ eventually pa f ∨ p (rr p pa)) ∧
(¬ eventually p fa ∨ ¬ pa (rr p pa) ∨ eventually pa fa)"
by (metis (no_types) eventually_mono)
then show ?thesis
using f1 calculation by meson
qed
moreover have "∀⇩F i in at_left (y t0). i < y t0"
by (simp add: eventually_at_filter)
ultimately have "∀⇩F i in at_left (y t0). ∀x∈{t0..t}. flow t0 i x ≤ v x"
proof eventually_elim
case (elim y')
show ?case
proof safe
fix s assume s: "s ∈ {t0..t}"
show "flow t0 y' s ≤ v s"
proof cases
assume "s = t0" with elim iv show ?thesis
by (simp add: ‹t0 ∈ T› ‹y' ∈ X›)
next
assume "s ≠ t0" with s have "t0 < s" by simp
have "{t0 -- s} ⊆ S" using ‹{t0--t} ⊆ S› closed_segment_eq_real_ivl s by auto
from s elim have "{t0..s} ⊆ existence_ivl t0 y'"
using ivl_subset_existence_ivl by blast
with flow_solves_ode have sol: "(flow t0 y' solves_ode f) {t0 .. s} X"
by (rule solves_ode_on_subset) (auto intro!: ‹y' ∈ X› ‹t0 ∈ T›)
have "{t0 .. s} ⊆ S" using ‹{t0 -- s} ⊆ S› by (simp add: closed_segment_eq_real_ivl split: if_splits)
with v' have v': "(v has_vderiv_on v') {t0 .. s}"
by (rule has_vderiv_on_subset)
from ‹y' < y t0› ‹v t0 = y t0› have less_init: "flow t0 y' t0 < v t0"
by (simp add: flow_initial_time_if ‹t0 ∈ T› ‹y' ∈ X›)
from strict_upper_solution[OF sol v' upper less_imp_le[OF less_init] _ ‹t0 < s›]
‹{t0 .. s} ⊆ S›
less_init ‹t0 < s›
have "flow t0 y' s < v s" by (simp add: subset_iff is_interval_cc)
then show ?thesis by simp
qed
qed
qed
}
moreover have "t ∈ {t0 .. t}" using ‹t0 ≤ t› by simp
ultimately have "flow t0 (y t0) t ≤ v t"
by (rule uniform_limit_le_const[OF trivial_limit_at_left_real])
also have "flow t0 (y t0) t = y t"
using sol t
by (intro maximal_existence_flow) auto
finally show ?thesis .
next
assume "v t0 ≠ y t0" then have less: "y t0 < v t0" using iv by simp
show ?thesis
apply (cases "t0 = t")
subgoal using iv by blast
subgoal using strict_upper_solution[OF sol v' upper iv] less t by force
done
qed
end
end
Theory Poincare_Map
theory Poincare_Map
imports
Flow
begin
abbreviation "plane n c ≡ {x. x ∙ n = c}"
lemma
eventually_tendsto_compose_within:
assumes "eventually P (at l within S)"
assumes "P l"
assumes "(f ⤏ l) (at x within T)"
assumes "eventually (λx. f x ∈ S) (at x within T)"
shows "eventually (λx. P (f x)) (at x within T)"
proof -
from assms(1) assms(2) obtain U where U:
"open U" "l ∈ U" "⋀x. x ∈ U ⟹ x ∈ S ⟹ P x"
by (force simp: eventually_at_topological)
from topological_tendstoD[OF assms(3) ‹open U› ‹l ∈ U›]
have "∀⇩F x in at x within T. f x ∈ U" by auto
then show ?thesis using assms(4)
by eventually_elim (auto intro!: U)
qed
lemma
eventually_eventually_withinI:
assumes "∀⇩F x in at x within A. P x" "P x"
shows "∀⇩F a in at x within S. ∀⇩F x in at a within A. P x"
using assms
unfolding eventually_at_topological
by force
lemma eventually_not_in_closed:
assumes "closed P"
assumes "f t ∉ P" "t ∈ T"
assumes "continuous_on T f"
shows "∀⇩F t in at t within T. f t ∉ P"
using assms
unfolding Compl_iff[symmetric] closed_def continuous_on_topological eventually_at_topological
by metis
context ll_on_open_it begin
lemma
existence_ivl_trans':
assumes "t + s ∈ existence_ivl t0 x0"
"t ∈ existence_ivl t0 x0"
shows "t + s ∈ existence_ivl t (flow t0 x0 t)"
by (meson assms(1) assms(2) general.existence_ivl_reverse general.flow_solves_ode
general.is_interval_existence_ivl general.maximal_existence_flow(1)
general.mem_existence_ivl_iv_defined(2) general.mem_existence_ivl_subset
local.existence_ivl_subset subsetD)
end
context auto_ll_on_open
begin
definition returns_to ::"'a set ⇒ 'a ⇒ bool"
where "returns_to P x ⟷ (∀⇩F t in at_right 0. flow0 x t ∉ P) ∧ (∃t>0. t ∈ existence_ivl0 x ∧ flow0 x t ∈ P)"
definition return_time :: "'a set ⇒ 'a ⇒ real"
where "return_time P x =
(if returns_to P x then (SOME t.
t > 0 ∧
t ∈ existence_ivl0 x ∧
flow0 x t ∈ P ∧
(∀s ∈ {0<..<t}. flow0 x s ∉ P)) else 0)"
lemma returns_toI:
assumes t: "t > 0" "t ∈ existence_ivl0 x" "flow0 x t ∈ P"
assumes ev: "∀⇩F t in at_right 0. flow0 x t ∉ P"
assumes "closed P"
shows "returns_to P x"
using assms
by (auto simp: returns_to_def)
lemma returns_to_outsideI:
assumes t: "t ≥ 0" "t ∈ existence_ivl0 x" "flow0 x t ∈ P"
assumes ev: "x ∉ P"
assumes "closed P"
shows "returns_to P x"
proof cases
assume "t > 0"
moreover
have "∀⇩F s in at 0 within {0 .. t}. flow0 x s ∉ P"
using assms mem_existence_ivl_iv_defined ivl_subset_existence_ivl[OF ‹t ∈ _›] ‹0 < t›
by (auto intro!: eventually_not_in_closed flow_continuous_on continuous_intros
simp: eventually_conj_iff)
with order_tendstoD(2)[OF tendsto_ident_at ‹0 < t›, of "{0<..}"]
have "∀⇩F t in at_right 0. flow0 x t ∉ P"
unfolding eventually_at_filter
by eventually_elim (use ‹t > 0› in auto)
then show ?thesis
by (auto intro!: returns_toI assms ‹0 < t›)
qed (use assms in simp)
lemma returns_toE:
assumes "returns_to P x"
obtains t0 t1 where
"0 < t0"
"t0 ≤ t1"
"t1 ∈ existence_ivl0 x"
"flow0 x t1 ∈ P"
"⋀t. 0 < t ⟹ t < t0 ⟹ flow0 x t ∉ P"
proof -
obtain t0 t1 where t0: "t0 > 0" "⋀t. 0 < t ⟹ t < t0 ⟹ flow0 x t ∉ P"
and t1: "t1 > 0" "t1 ∈ existence_ivl0 x" "flow0 x t1 ∈ P"
using assms
by (auto simp: returns_to_def eventually_at_right[OF zero_less_one])
moreover
have "t0 ≤ t1"
using t0(2)[of t1] t1 t0(1)
by force
ultimately show ?thesis by (blast intro: that)
qed
lemma return_time_some:
assumes "returns_to P x"
shows "return_time P x =
(SOME t. t > 0 ∧ t ∈ existence_ivl0 x ∧ flow0 x t ∈ P ∧ (∀s ∈ {0<..<t}. flow0 x s ∉ P))"
using assms by (auto simp: return_time_def)
lemma return_time_ex1:
assumes "returns_to P x"
assumes "closed P"
shows "∃!t. t > 0 ∧ t ∈ existence_ivl0 x ∧ flow0 x t ∈ P ∧ (∀s ∈ {0<..<t}. flow0 x s ∉ P)"
proof -
from returns_toE[OF ‹returns_to P x›]
obtain t0 t1 where
t1: "t1 ≥ t0" "t1 ∈ existence_ivl0 x" "flow0 x t1 ∈ P"
and t0: "t0 > 0" "⋀t. 0 < t ⟹ t < t0 ⟹ flow0 x t ∉ P"
by metis
from flow_continuous_on have cont: "continuous_on {0 .. t1} (flow0 x)"
by (rule continuous_on_subset) (intro ivl_subset_existence_ivl t1)
from cont have cont': "continuous_on {t0 .. t1} (flow0 x)"
by (rule continuous_on_subset) (use ‹0 < t0› in auto)
have "compact (flow0 x -` P ∩ {t0 .. t1})"
using ‹closed P› cont'
by (auto simp: compact_eq_bounded_closed bounded_Int bounded_closed_interval
intro!: closed_vimage_Int)
have "flow0 x -` P ∩ {t0..t1} ≠ {}"
using t1 t0 by auto
from compact_attains_inf[OF ‹compact _› this] t0 t1
obtain rt where rt: "t0 ≤ rt" "rt ≤ t1" "flow0 x rt ∈ P"
and least: "⋀t'. flow0 x t' ∈ P ⟹ t0 ≤ t' ⟹ t' ≤ t1 ⟹ rt ≤ t'"
by auto
have "0 < rt" "flow0 x rt ∈ P" "rt ∈ existence_ivl0 x"
and "0 < t' ⟹ t' < rt ⟹ flow0 x t' ∉ P" for t'
using ivl_subset_existence_ivl[OF ‹t1 ∈ existence_ivl0 x›] t0 t1 rt least[of t']
by force+
then show ?thesis
by (intro ex_ex1I) force+
qed
lemma
return_time_pos_returns_to:
"return_time P x > 0 ⟹ returns_to P x"
by (auto simp: return_time_def split: if_splits)
lemma
assumes ret: "returns_to P x"
assumes "closed P"
shows return_time_pos: "return_time P x > 0"
using someI_ex[OF return_time_ex1[OF assms, THEN ex1_implies_ex]]
unfolding return_time_some[OF ret, symmetric]
by auto
lemma returns_to_return_time_pos:
assumes "closed P"
shows "returns_to P x ⟷ return_time P x > 0"
by (auto intro!: return_time_pos assms) (auto simp: return_time_def split: if_splits)
lemma return_time:
assumes ret: "returns_to P x"
assumes "closed P"
shows "return_time P x > 0"
and return_time_exivl: "return_time P x ∈ existence_ivl0 x"
and return_time_returns: "flow0 x (return_time P x) ∈ P"
and return_time_least: "⋀s. 0 < s ⟹ s < return_time P x ⟹ flow0 x s ∉ P"
using someI_ex[OF return_time_ex1[OF assms, THEN ex1_implies_ex]]
unfolding return_time_some[OF ret, symmetric]
by auto
lemma returns_to_earlierI:
assumes ret: "returns_to P (flow0 x t)" "closed P"
assumes "t ≥ 0" "t ∈ existence_ivl0 x"
assumes ev: "∀⇩F t in at_right 0. flow0 x t ∉ P"
shows "returns_to P x"
proof -
from return_time[OF ret]
have rt: "0 < return_time P (flow0 x t)" "flow0 (flow0 x t) (return_time P (flow0 x t)) ∈ P"
and "0 < s ⟹ s < return_time P (flow0 x t) ⟹ flow0 (flow0 x t) s ∉ P" for s
by auto
let ?t = "t + return_time P (flow0 x t)"
show ?thesis
proof (rule returns_toI[of ?t])
show "0 < ?t" by (auto intro!: add_nonneg_pos rt ‹t ≥ 0›)
show "?t ∈ existence_ivl0 x"
by (intro existence_ivl_trans return_time_exivl assms)
have "flow0 x (t + return_time P (flow0 x t)) = flow0 (flow0 x t) (return_time P (flow0 x t))"
by (intro flow_trans assms return_time_exivl)
also have "… ∈ P"
by (rule return_time_returns[OF ret])
finally show "flow0 x (t + return_time P (flow0 x t)) ∈ P" .
show "closed P" by fact
show "∀⇩F t in at_right 0. flow0 x t ∉ P" by fact
qed
qed
lemma return_time_gt:
assumes ret: "returns_to P x" "closed P"
assumes flow_not: "⋀s. 0 < s ⟹ s ≤ t ⟹ flow0 x s ∉ P"
shows "t < return_time P x"
using flow_not[of "return_time P x"] return_time_pos[OF ret] return_time_returns[OF ret] by force
lemma return_time_le:
assumes ret: "returns_to P x" "closed P"
assumes flow_not: "flow0 x t ∈ P" "t > 0"
shows "return_time P x ≤ t"
using return_time_least[OF assms(1,2), of t] flow_not
by force
lemma returns_to_laterI:
assumes ret: "returns_to P x" "closed P"
assumes t: "t > 0" "t ∈ existence_ivl0 x"
assumes flow_not: "⋀s. 0 < s ⟹ s ≤ t ⟹ flow0 x s ∉ P"
shows "returns_to P (flow0 x t)"
apply (rule returns_toI[of "return_time P x - t"])
subgoal using flow_not by (auto intro!: return_time_gt ret)
subgoal by (auto intro!: existence_ivl_trans' return_time_exivl ret t)
subgoal by (subst flow_trans[symmetric])
(auto intro!: existence_ivl_trans' return_time_exivl ret t return_time_returns)
subgoal
proof -
have "∀⇩F y in nhds 0. y ∈ existence_ivl0 (flow0 x t)"
apply (rule eventually_nhds_in_open[OF open_existence_ivl[of "flow0 x t"] existence_ivl_zero])
apply (rule flow_in_domain)
apply fact
done
then have "∀⇩F s in at_right 0. s ∈ existence_ivl0 (flow0 x t)"
unfolding eventually_at_filter
by eventually_elim auto
moreover
have "∀⇩F s in at_right 0. t + s < return_time P x"
using return_time_gt[OF ret flow_not, of t]
by (auto simp: eventually_at_right[OF zero_less_one] intro!: exI[of _ "return_time P x - t"])
moreover
have "∀⇩F s in at_right 0. 0 < t + s"
by (metis (mono_tags) eventually_at_rightI greaterThanLessThan_iff pos_add_strict t(1))
ultimately show ?thesis
apply eventually_elim
apply (subst flow_trans[symmetric])
using return_time_least[OF ret]
by (auto intro!: existence_ivl_trans' t)
qed
subgoal by fact
done
lemma never_returns:
assumes "¬returns_to P x"
assumes "closed P" "t ≥ 0" "t ∈ existence_ivl0 x"
assumes ev: "∀⇩F t in at_right 0. flow0 x t ∉ P"
shows "¬returns_to P (flow0 x t)"
using returns_to_earlierI[OF _ assms(2-5)] assms(1)
by blast
lemma return_time_eqI:
assumes "closed P"
and t_pos: "t > 0"
and ex: "t ∈ existence_ivl0 x"
and ret: "flow0 x t ∈ P"
and least: "⋀s. 0 < s ⟹ s < t ⟹ flow0 x s ∉ P"
shows "return_time P x = t"
proof -
from least t_pos have "∀⇩F t in at_right 0. flow0 x t ∉ P"
by (auto simp: eventually_at_right[OF zero_less_one])
then have "returns_to P x"
by (auto intro!: returns_toI[of t] assms)
then show ?thesis
using least
by (auto simp: return_time_def t_pos ex ret
intro!: some1_equality[OF return_time_ex1[OF ‹returns_to _ _› ‹closed _›]])
qed
lemma return_time_step:
assumes "returns_to P (flow0 x t)"
assumes "closed P"
assumes flow_not: "⋀s. 0 < s ⟹ s ≤ t ⟹ flow0 x s ∉ P"
assumes t: "t > 0" "t ∈ existence_ivl0 x"
shows "return_time P (flow0 x t) = return_time P x - t"
proof -
from flow_not t have "∀⇩F t in at_right 0. flow0 x t ∉ P"
by (auto simp: eventually_at_right[OF zero_less_one])
from returns_to_earlierI[OF assms(1,2) less_imp_le, OF t this]
have ret: "returns_to P x" .
from return_time_gt[OF ret ‹closed P› flow_not]
have "t < return_time P x" by simp
moreover
have "0 < s ⟹ s < return_time P x - t ⟹ flow0 (flow0 x t) s = flow0 x (t + s)" for s
using ivl_subset_existence_ivl[OF return_time_exivl[OF ret ‹closed _›]] t
by (subst flow_trans) (auto intro!: existence_ivl_trans')
ultimately show ?thesis
using flow_not assms(1) ret return_time_least t(1)
by (auto intro!: return_time_eqI return_time_returns ret
simp: flow_trans[symmetric] ‹closed P› t(2) existence_ivl_trans' return_time_exivl)
qed
definition "poincare_map P x = flow0 x (return_time P x)"
lemma poincare_map_step_flow:
assumes ret: "returns_to P x" "closed P"
assumes flow_not: "⋀s. 0 < s ⟹ s ≤ t ⟹ flow0 x s ∉ P"
assumes t: "t > 0" "t ∈ existence_ivl0 x"
shows "poincare_map P (flow0 x t) = poincare_map P x"
unfolding poincare_map_def
apply (subst flow_trans[symmetric])
subgoal by fact
subgoal using flow_not by (auto intro!: return_time_exivl returns_to_laterI t ret)
subgoal
using flow_not
by (subst return_time_step) (auto intro!: return_time_exivl returns_to_laterI t ret)
done
lemma poincare_map_returns:
assumes "returns_to P x" "closed P"
shows "poincare_map P x ∈ P"
by (auto intro!: return_time_returns assms simp: poincare_map_def)
lemma poincare_map_onto:
assumes "closed P"
assumes "0 < t" "t ∈ existence_ivl0 x" "∀⇩F t in at_right 0. flow0 x t ∉ P"
assumes "flow0 x t ∈ P"
shows "poincare_map P x ∈ flow0 x ` {0 <.. t} ∩ P"
proof (rule IntI)
have "returns_to P x"
by (rule returns_toI) (rule assms)+
then have "return_time P x ∈ {0<..t}"
by (auto intro!: return_time_pos assms return_time_le)
then show "poincare_map P x ∈ flow0 x ` {0<..t}"
by (auto simp: poincare_map_def)
show "poincare_map P x ∈ P"
by (auto intro!: poincare_map_returns ‹returns_to _ _› ‹closed _›)
qed
end
lemma isCont_blinfunD:
fixes f'::"'a::metric_space ⇒ 'b::real_normed_vector ⇒⇩L 'c::real_normed_vector"
assumes "isCont f' a" "0 < e"
shows "∃d>0. ∀x. dist a x < d ⟶ onorm (λv. blinfun_apply (f' x) v - blinfun_apply (f' a) v) < e"
proof -
have "∀⇩F x in at a. dist (f' x) (f' a) < e"
using assms isCont_def tendsto_iff by blast
then show ?thesis
using ‹e > 0› norm_eq_zero
by (force simp: eventually_at dist_commute dist_norm norm_blinfun.rep_eq
simp flip: blinfun.bilinear_simps)
qed
proposition has_derivative_locally_injective_blinfun:
fixes f :: "'n::euclidean_space ⇒ 'm::euclidean_space"
and f'::"'n ⇒ 'n ⇒⇩L 'm"
and g'::"'m ⇒⇩L 'n"
assumes "a ∈ s"
and "open s"
and g': "g' o⇩L (f' a) = 1⇩L"
and f': "⋀x. x ∈ s ⟹ (f has_derivative f' x) (at x)"
and c: "isCont f' a"
obtains r where "r > 0" "ball a r ⊆ s" "inj_on f (ball a r)"
proof -
have bl: "bounded_linear (blinfun_apply g')"
by (auto simp: blinfun.bounded_linear_right)
from g' have g': "blinfun_apply g' ∘ blinfun_apply (f' a) = id"
by transfer (simp add: id_def)
from has_derivative_locally_injective[OF ‹a ∈ s› ‹open s› bl g' f' isCont_blinfunD[OF c]]
obtain r where "0 < r" "ball a r ⊆ s" "inj_on f (ball a r)"
by auto
then show ?thesis ..
qed
lift_definition embed1_blinfun::"'a::real_normed_vector ⇒⇩L ('a*'b::real_normed_vector)" is "λx. (x, 0)"
by standard (auto intro!: exI[where x=1])
lemma blinfun_apply_embed1_blinfun[simp]: "blinfun_apply embed1_blinfun x = (x, 0)"
by transfer simp
lift_definition embed2_blinfun::"'a::real_normed_vector ⇒⇩L ('b::real_normed_vector*'a)" is "λx. (0, x)"
by standard (auto intro!: exI[where x=1])
lemma blinfun_apply_embed2_blinfun[simp]: "blinfun_apply embed2_blinfun x = (0, x)"
by transfer simp
lemma blinfun_inverseD: "f o⇩L f' = 1⇩L ⟹ f (f' x) = x"
apply transfer
unfolding o_def
by meson
lemmas continuous_on_open_vimageI = continuous_on_open_vimage[THEN iffD1, rule_format]
lemmas continuous_on_closed_vimageI = continuous_on_closed_vimage[THEN iffD1, rule_format]
lemma ball_times_subset: "ball a (c/2) × ball b (c/2) ⊆ ball (a, b) c"
proof -
{
fix a' b'
have "sqrt ((dist a a')⇧2 + (dist b b')⇧2) ≤ dist a a' + dist b b'"
by (rule real_le_lsqrt) (auto simp: power2_eq_square algebra_simps)
also assume "a' ∈ ball a (c / 2)"
then have "dist a a' < c / 2" by (simp add:)
also assume "b' ∈ ball b (c / 2)"
then have "dist b b' < c / 2" by (simp add:)
finally have "sqrt ((dist a a')⇧2 + (dist b b')⇧2) < c"
by simp
} thus ?thesis by (auto simp: dist_prod_def mem_cball)
qed
lemma linear_inverse_blinop_lemma:
fixes w::"'a::{banach, perfect_space} blinop"
assumes "norm w < 1"
shows
"summable (λn. (-1)^n *⇩R w^n)" (is ?C)
"(∑n. (-1)^n *⇩R w^n) * (1 + w) = 1" (is ?I1)
"(1 + w) * (∑n. (-1)^n *⇩R w^n) = 1" (is ?I2)
"norm ((∑n. (-1)^n *⇩R w^n) - 1 + w) ≤ (norm w)⇧2/(1 - norm (w))" (is ?L)
proof -
have "summable (λn. norm w ^ n)"
apply (rule summable_geometric)
using assms by auto
then have "summable (λn. norm (w ^ n))"
by (rule summable_comparison_test'[where N=0]) (auto intro!: norm_power_ineq)
then show ?C
by (rule summable_comparison_test'[where N=0]) (auto simp: norm_power )
{
fix N
have 1: "(1 + w) * sum (λn. (-1)^n *⇩R w^n) {..<N} = sum (λn. (-1)^n *⇩R w^n) {..<N} * (1 + w)"
by (auto simp: algebra_simps sum_distrib_left sum_distrib_right sum.distrib power_commutes)
also have "… = sum (λn. (-1)^n *⇩R w^n - (-1)^Suc n *⇩R w^ Suc n) {..<N}"
by (auto simp: algebra_simps sum_distrib_left sum_distrib_right sum.distrib power_commutes)
also have "… = 1 - (-1)^N *⇩R w^N"
by (subst sum_lessThan_telescope') (auto simp: algebra_simps)
finally have "(1 + w) * (∑n<N. (- 1) ^ n *⇩R w ^ n) = 1 - (- 1) ^ N *⇩R w ^ N" .
note 1 this
} note nu = this
show "?I1"
apply (subst suminf_mult2, fact)
apply (subst suminf_eq_lim)
apply (subst sum_distrib_right[symmetric])
apply (rule limI)
apply (subst nu(1)[symmetric])
apply (subst nu(2))
apply (rule tendsto_eq_intros)
apply (rule tendsto_intros)
apply (rule tendsto_norm_zero_cancel)
apply auto
apply (rule Lim_transform_bound[where g="λi. norm w ^ i"])
apply (rule eventuallyI)
apply simp apply (rule norm_power_ineq)
apply (auto intro!: LIMSEQ_power_zero assms)
done
show "?I2"
apply (subst suminf_mult[symmetric], fact)
apply (subst suminf_eq_lim)
apply (subst sum_distrib_left[symmetric])
apply (rule limI)
apply (subst nu(2))
apply (rule tendsto_eq_intros)
apply (rule tendsto_intros)
apply (rule tendsto_norm_zero_cancel)
apply auto
apply (rule Lim_transform_bound[where g="λi. norm w ^ i"])
apply (rule eventuallyI)
apply simp apply (rule norm_power_ineq)
apply (auto intro!: LIMSEQ_power_zero assms)
done
have *: "(∑n. (- 1) ^ n *⇩R w ^ n) - 1 + w = (w⇧2 * (∑n. (- 1) ^ n *⇩R w ^ n))"
apply (subst suminf_split_initial_segment[where k=2], fact)
apply (subst suminf_mult[symmetric], fact)
by (auto simp: power2_eq_square algebra_simps eval_nat_numeral)
also have "norm … ≤ (norm w)⇧2 / (1 - norm w)"
proof -
have §: "norm (∑n. (- 1) ^ n *⇩R w ^ n) ≤ 1 / (1 - norm w)"
apply (rule order_trans[OF summable_norm])
apply auto
apply fact
apply (rule order_trans[OF suminf_le])
apply (rule norm_power_ineq)
apply fact
apply fact
by (auto simp: suminf_geometric assms)
show ?thesis
apply (rule order_trans[OF norm_mult_ineq])
apply (subst divide_inverse)
apply (rule mult_mono)
apply (auto simp: norm_power_ineq inverse_eq_divide assms §)
done
qed
finally show ?L .
qed
lemma linear_inverse_blinfun_lemma:
fixes w::"'a ⇒⇩L 'a::{banach, perfect_space}"
assumes "norm w < 1"
obtains I where
"I o⇩L (1⇩L + w) = 1⇩L" "(1⇩L + w) o⇩L I = 1⇩L"
"norm (I - 1⇩L + w) ≤ (norm w)⇧2/(1 - norm (w))"
proof -
define v::"'a blinop" where "v = Blinop w"
have "norm v = norm w"
unfolding v_def
apply transfer
by (simp add: bounded_linear_Blinfun_apply norm_blinfun.rep_eq)
with assms have "norm v < 1" by simp
from linear_inverse_blinop_lemma[OF this]
have v: "(∑n. (- 1) ^ n *⇩R v ^ n) * (1 + v) = 1"
"(1 + v) * (∑n. (- 1) ^ n *⇩R v ^ n) = 1"
"norm ((∑n. (- 1) ^ n *⇩R v ^ n) - 1 + v) ≤ (norm v)⇧2 / (1 - norm v)"
by auto
define J::"'a blinop" where "J = (∑n. (- 1) ^ n *⇩R v ^ n)"
define I::"'a ⇒⇩L 'a" where "I = Blinfun J"
have "Blinfun (blinop_apply J) - 1⇩L + w = Rep_blinop (J - 1 + Blinop (blinfun_apply w))"
by transfer' (auto simp: blinfun_apply_inverse)
then have ne: "norm (Blinfun (blinop_apply J) - 1⇩L + w) =
norm (J - 1 + Blinop (blinfun_apply w))"
by (auto simp: norm_blinfun_def norm_blinop_def)
from v have
"I o⇩L (1⇩L + w) = 1⇩L" "(1⇩L + w) o⇩L I = 1⇩L"
"norm (I - 1⇩L + w) ≤ (norm w)⇧2/(1 - norm (w))"
apply (auto simp: I_def J_def[symmetric])
unfolding v_def
apply (auto simp: blinop.bounded_linear_right bounded_linear_Blinfun_apply
intro!: blinfun_eqI)
subgoal by transfer
(auto simp: blinfun_ext blinfun.bilinear_simps bounded_linear_Blinfun_apply)
subgoal
by transfer (auto simp: Transfer.Rel_def
blinfun_ext blinfun.bilinear_simps bounded_linear_Blinfun_apply)
subgoal
apply (auto simp: ne)
apply transfer
by (auto simp: norm_blinfun_def bounded_linear_Blinfun_apply)
done
then show ?thesis ..
qed
definition "invertibles_blinfun = {w. ∃wi. w o⇩L wi = 1⇩L ∧ wi o⇩L w = 1⇩L}"
lemma blinfun_inverse_open:
shows "open (invertibles_blinfun::
('a::{banach, perfect_space} ⇒⇩L 'b::banach) set)"
proof (rule openI)
fix u0::"'a ⇒⇩L 'b"
assume "u0 ∈ invertibles_blinfun"
then obtain u0i where u0i: "u0 o⇩L u0i = 1⇩L" "u0i o⇩L u0 = 1⇩L"
by (auto simp: invertibles_blinfun_def)
then have [simp]: "u0i ≠ 0"
apply (auto)
by (metis one_blinop.abs_eq zero_blinop.abs_eq zero_neq_one)
let ?e = "inverse (norm u0i)"
show "∃e>0. ball u0 e ⊆ invertibles_blinfun"
apply (clarsimp intro!: exI[where x = ?e] simp: invertibles_blinfun_def)
subgoal premises prems for u0s
proof -
define s where "s = u0s - u0"
have u0s: "u0s = u0 + s"
by (auto simp: s_def)
have "norm (u0i o⇩L s) < 1"
using prems by (auto simp: dist_norm u0s
divide_simps ac_simps intro!: le_less_trans[OF norm_blinfun_compose])
from linear_inverse_blinfun_lemma[OF this]
obtain I where I:
"I o⇩L 1⇩L + (u0i o⇩L s) = 1⇩L"
"1⇩L + (u0i o⇩L s) o⇩L I = 1⇩L"
"norm (I - 1⇩L + (u0i o⇩L s)) ≤ (norm (u0i o⇩L s))⇧2 / (1 - norm (u0i o⇩L s))"
by auto
have u0s_eq: "u0s = u0 o⇩L (1⇩L + (u0i o⇩L s))"
using u0i
by (auto simp: s_def blinfun.bilinear_simps blinfun_ext)
show ?thesis
apply (rule exI[where x="I o⇩L u0i"])
using I u0i
apply (auto simp: u0s_eq)
by (auto simp: algebra_simps blinfun_ext blinfun.bilinear_simps)
qed
done
qed
lemma blinfun_compose_assoc[ac_simps]: "a o⇩L b o⇩L c = a o⇩L (b o⇩L c)"
by (auto intro!: blinfun_eqI)
text ‹TODO: move @{thm norm_minus_cancel} to class!›
lemma (in real_normed_vector) norm_minus_cancel [simp]: "norm (- x) = norm x"
proof -
have scaleR_minus_left: "- a *⇩R x = - (a *⇩R x)" for a x
proof -
have "∀x1 x2. (x2::real) + x1 = x1 + x2"
by auto
then have f1: "∀r ra a. (ra + r) *⇩R (a::'a) = r *⇩R a + ra *⇩R a"
using local.scaleR_add_left by presburger
have f2: "a + a = 2 * a"
by force
have f3: "2 * a + - 1 * a = a"
by auto
have "- a = - 1 * a"
by auto
then show ?thesis
using f3 f2 f1 by (metis local.add_minus_cancel local.add_right_imp_eq)
qed
have "norm (- x) = norm (scaleR (- 1) x)"
by (simp only: scaleR_minus_left scaleR_one)
also have "… = ¦- 1¦ * norm x"
by (rule norm_scaleR)
finally show ?thesis by simp
qed
text ‹TODO: move @{thm norm_minus_commute} to class!›
lemma (in real_normed_vector) norm_minus_commute: "norm (a - b) = norm (b - a)"
proof -
have "norm (- (b - a)) = norm (b - a)"
by (rule norm_minus_cancel)
then show ?thesis by simp
qed
instance euclidean_space ⊆ banach
by standard
lemma blinfun_apply_Pair_split:
"blinfun_apply g (a, b) = blinfun_apply g (a, 0) + blinfun_apply g (0, b)"
unfolding blinfun.bilinear_simps[symmetric] by simp
lemma blinfun_apply_Pair_add2: "blinfun_apply f (0, a + b) = blinfun_apply f (0, a) + blinfun_apply f (0, b)"
unfolding blinfun.bilinear_simps[symmetric] by simp
lemma blinfun_apply_Pair_add1: "blinfun_apply f (a + b, 0) = blinfun_apply f (a, 0) + blinfun_apply f (b, 0)"
unfolding blinfun.bilinear_simps[symmetric] by simp
lemma blinfun_apply_Pair_minus2: "blinfun_apply f (0, a - b) = blinfun_apply f (0, a) - blinfun_apply f (0, b)"
unfolding blinfun.bilinear_simps[symmetric] by simp
lemma blinfun_apply_Pair_minus1: "blinfun_apply f (a - b, 0) = blinfun_apply f (a, 0) - blinfun_apply f (b, 0)"
unfolding blinfun.bilinear_simps[symmetric] by simp
lemma implicit_function_theorem:
fixes f::"'a::euclidean_space * 'b::euclidean_space ⇒ 'c::euclidean_space"
assumes [derivative_intros]: "⋀x. x ∈ S ⟹ (f has_derivative blinfun_apply (f' x)) (at x)"
assumes S: "(x, y) ∈ S" "open S"
assumes "DIM('c) ≤ DIM('b)"
assumes f'C: "isCont f' (x, y)"
assumes "f (x, y) = 0"
assumes T2: "T o⇩L (f' (x, y) o⇩L embed2_blinfun) = 1⇩L"
assumes T1: "(f' (x, y) o⇩L embed2_blinfun) o⇩L T = 1⇩L"
obtains u e r
where "f (x, u x) = 0" "u x = y"
"⋀s. s ∈ cball x e ⟹ f (s, u s) = 0"
"continuous_on (cball x e) u"
"(λt. (t, u t)) ` cball x e ⊆ S"
"e > 0"
"(u has_derivative - T o⇩L f' (x, y) o⇩L embed1_blinfun) (at x)"
"r > 0"
"⋀U v s. v x = y ⟹ (⋀s. s ∈ U ⟹ f (s, v s) = 0) ⟹ U ⊆ cball x e ⟹
continuous_on U v ⟹ s ∈ U ⟹ (s, v s) ∈ ball (x, y) r ⟹ u s = v s"
proof -
define H where "H ≡ λ(x, y). (x, f (x, y))"
define H' where "H' ≡ λx. (embed1_blinfun o⇩L fst_blinfun) + (embed2_blinfun o⇩L (f' x))"
have f'_inv: "f' (x, y) o⇩L embed2_blinfun ∈ invertibles_blinfun"
using T1 T2 by (auto simp: invertibles_blinfun_def ac_simps intro!: exI[where x=T])
from openE[OF blinfun_inverse_open this]
obtain d0 where e0: "0 < d0"
"ball (f' (x, y) o⇩L embed2_blinfun) d0 ⊆ invertibles_blinfun"
by auto
have "isCont (λs. f' s o⇩L embed2_blinfun) (x, y)"
by (auto intro!: continuous_intros f'C)
from this[unfolded isCont_def, THEN tendstoD, OF ‹0 < d0›]
have "∀⇩F s in at (x, y). f' s o⇩L embed2_blinfun ∈ invertibles_blinfun"
apply eventually_elim
using e0 by (auto simp: subset_iff dist_commute)
then obtain e0 where "e0 > 0"
"xa ≠ (x, y) ⟹ dist xa (x, y) < e0 ⟹
f' xa o⇩L embed2_blinfun ∈ invertibles_blinfun" for xa
unfolding eventually_at
by auto
then have e0: "e0 > 0"
"dist xa (x, y) < e0 ⟹ f' xa o⇩L embed2_blinfun ∈ invertibles_blinfun" for xa
apply -
subgoal by simp
using f'_inv
apply (cases "xa = (x, y)")
by auto
have H': "x ∈ S ⟹ (H has_derivative H' x) (at x)" for x
unfolding H_def H'_def
by (auto intro!: derivative_eq_intros ext simp: blinfun.bilinear_simps)
have cH': "isCont H' (x, y)"
unfolding H'_def
by (auto intro!: continuous_intros assms)
have linear_H': "⋀s. s ∈ S ⟹ linear (H' s)"
using H' assms(2) has_derivative_linear by blast
have *: "blinfun_apply T (blinfun_apply (f' (x, y)) (0, b)) = b" for b
using blinfun_inverseD[OF T2, of b]
by simp
have "inj (f' (x, y) o⇩L embed2_blinfun)"
by (metis (no_types, lifting) "*" blinfun_apply_blinfun_compose embed2_blinfun.rep_eq injI)
then have [simp]: "blinfun_apply (f' (x, y)) (0, b) = 0 ⟹ b = 0" for b
apply (subst (asm) linear_injective_0)
subgoal
apply (rule bounded_linear.linear)
apply (rule blinfun.bounded_linear_right)
done
subgoal by simp
done
have "inj (H' (x, y))"
apply (subst linear_injective_0)
apply (rule linear_H')
apply fact
apply (auto simp: H'_def blinfun.bilinear_simps zero_prod_def)
done
define Hi where "Hi = (embed1_blinfun o⇩L fst_blinfun) + ((embed2_blinfun o⇩L T o⇩L (snd_blinfun - (f' (x, y) o⇩L embed1_blinfun o⇩L fst_blinfun))))"
have Hi': "(λu. snd (blinfun_apply Hi (u, 0))) = - T o⇩L f' (x, y) o⇩L embed1_blinfun"
by (auto simp: Hi_def blinfun.bilinear_simps)
have Hi: "Hi o⇩L H' (x, y) = 1⇩L"
apply (auto simp: H'_def fun_eq_iff blinfun.bilinear_simps Hi_def
intro!: ext blinfun_eqI)
apply (subst blinfun_apply_Pair_split)
by (auto simp: * blinfun.bilinear_simps)
from has_derivative_locally_injective_blinfun[OF S this H' cH']
obtain r0 where r0: "0 < r0" "ball (x, y) r0 ⊆ S" and inj: "inj_on H (ball (x, y) r0)"
by auto
define r where "r = min r0 e0"
have r: "0 < r" "ball (x, y) r ⊆ S" and inj: "inj_on H (ball (x, y) r)"
and r_inv: "⋀s. s ∈ ball (x, y) r ⟹ f' s o⇩L embed2_blinfun ∈ invertibles_blinfun"
subgoal using e0 r0 by (auto simp: r_def)
subgoal using e0 r0 by (auto simp: r_def)
subgoal using inj apply (rule inj_on_subset)
using e0 r0 by (auto simp: r_def)
subgoal for s
using e0 r0 by (auto simp: r_def dist_commute)
done
obtain i::'a where "i ∈ Basis"
using nonempty_Basis by blast
define undef where "undef ≡ (x, y) + r *⇩R (i, 0)"
have ud: "¬ dist (x, y) undef < r"
using ‹r > 0› ‹i ∈ Basis› by (auto simp: undef_def dist_norm)
define G where "G ≡ the_inv_into (ball (x, y) r) H"
{
fix u v
assume [simp]: "(u, v) ∈ H ` ball (x, y) r"
note [simp] = inj
have "(u, v) = H (G (u, v))"
unfolding G_def
by (subst f_the_inv_into_f[where f=H]) auto
moreover have "… = H (G (u, v))"
by (auto simp: G_def)
moreover have "… = (fst (G (u, v)), f (G (u, v)))"
by (auto simp: H_def split_beta')
ultimately have "u = fst (G (u, v))" "v = f (G (u, v))" by simp_all
then have "f (u, snd (G(u, v))) = v" "u = fst (G (u, v))"
by (metis prod.collapse)+
} note uvs = this
note uv = uvs(1)
moreover
have "f (x, snd (G (x, 0))) = 0"
apply (rule uv)
by (metis (mono_tags, lifting) H_def assms(6) case_prod_beta' centre_in_ball fst_conv image_iff r(1) snd_conv)
moreover
have cH: "continuous_on S H"
apply (rule has_derivative_continuous_on)
apply (subst at_within_open)
apply (auto intro!: H' assms)
done
have inj2: "inj_on H (ball (x, y) (r / 2))"
apply (rule inj_on_subset, rule inj)
using r by auto
have oH: "open (H ` ball (x, y) (r/2))"
apply (rule invariance_of_domain_gen)
apply (auto simp: assms inj)
apply (rule continuous_on_subset)
apply fact
using r
apply auto
using inj2 apply simp
done
have "(x, f (x, y)) ∈ H ` ball (x, y) (r/2)"
using ‹r > 0› by (auto simp: H_def)
from open_contains_cball[THEN iffD1, OF oH, rule_format, OF this]
obtain e' where e': "e' > 0" "cball (x, f (x, y)) e' ⊆ H ` ball (x, y) (r/2)"
by auto
have inv_subset: "the_inv_into (ball (x, y) r) H a = the_inv_into R H a"
if "a ∈ H ` R" "R ⊆ (ball (x, y) r)"
for a R
apply (rule the_inv_into_f_eq[OF inj])
apply (rule f_the_inv_into_f)
apply (rule inj_on_subset[OF inj])
apply fact
apply fact
apply (rule the_inv_into_into)
apply (rule inj_on_subset[OF inj])
apply fact
apply fact
apply (rule order_trans)
apply fact
using r apply auto
done
have GH: "G (H z) = z" if "dist (x, y) z < r" for z
by (auto simp: G_def the_inv_into_f_f inj that)
define e where "e = min (e' / 2) e0"
define r2 where "r2 = r / 2"
have r2: "r2 > 0" "r2 < r"
using ‹r > 0› by (auto simp: r2_def)
have "e > 0" using e' e0 by (auto simp: e_def)
from cball_times_subset[of "x" e' "f (x, y)"] e'
have "cball x e × cball (f (x, y)) e ⊆ H ` ball (x, y) (r/2)"
by (force simp: e_def)
then have e_r_subset: "z ∈ cball x e ⟹ (z, 0) ∈ H ` ball (x, y) (r/2)" for z
using ‹0 < e› assms(6)
by (auto simp: H_def subset_iff)
have u0: "(u, 0) ∈ H ` ball (x, y) r" if "u ∈ cball x e" for u
apply (rule rev_subsetD)
apply (rule e_r_subset)
apply fact
unfolding r2_def using r2 by auto
have G_r: "G (u, 0) ∈ ball (x, y) r" if "u ∈ cball x e" for u
unfolding G_def
apply (rule the_inv_into_into)
apply fact
apply (auto)
apply (rule u0, fact)
done
note e_r_subset
ultimately have G2:
"f (x, snd (G (x, 0))) = 0" "snd (G (x, 0)) = y"
"⋀u. u ∈ cball x e ⟹ f (u, snd (G (u, 0))) = 0"
"continuous_on (cball x e) (λu. snd (G (u, 0)))"
"(λt. (t, snd (G (t, 0)))) ` cball x e ⊆ S"
"e > 0"
"((λu. snd (G (u, 0))) has_derivative (λu. snd (Hi (u, 0)))) (at x)"
apply (auto simp: G_def split_beta'
intro!: continuous_intros continuous_on_compose2[OF cH])
subgoal premises prems
proof -
have "the_inv_into (ball (x, y) r) H (x, 0) = (x, y)"
apply (rule the_inv_into_f_eq)
apply fact
by (auto simp: H_def assms ‹r > 0›)
then show ?thesis
by auto
qed
using r2(2) r2_def apply fastforce
apply (subst continuous_on_cong[OF refl])
apply (rule inv_subset[where R="cball (x, y) r2"])
subgoal
using r2
apply auto
using r2_def by force
subgoal using r2 by (force simp:)
subgoal
apply (rule continuous_on_compose2[OF continuous_on_inv_into])
using r(2) r2(2)
apply (auto simp: r2_def[symmetric]
intro!: continuous_on_compose2[OF cH] continuous_intros)
apply (rule inj_on_subset)
apply (rule inj)
using r(2) r2(2) apply force
apply force
done
subgoal premises prems for u
proof -
from prems have u: "u ∈ cball x e" by auto
note G_r[OF u]
also have "ball (x, y) r ⊆ S"
using r by simp
finally have "(G (u, 0)) ∈ S" .
then show ?thesis
unfolding G_def[symmetric]
using uvs(2)[OF u0, OF u]
by (metis prod.collapse)
qed
subgoal using ‹e > 0› by simp
subgoal premises prems
proof -
have "(x, y) ∈ cball (x, y) r2"
using r2
by auto
moreover
have "H (x, y) ∈ interior (H ` cball (x, y) r2)"
apply (rule interiorI[OF oH])
using r2 by (auto simp: r2_def)
moreover
have "cball (x, y) r2 ⊆ S"
using r r2 by auto
moreover have "⋀z. z ∈ cball (x, y) r2 ⟹ G (H z) = z"
using r2 by (auto intro!: GH)
ultimately have "(G has_derivative Hi) (at (H (x, y)))"
proof (rule has_derivative_inverse[where g = G and f = H,
OF compact_cball _ _ continuous_on_subset[OF cH] _ H' _ _])
show "blinfun_apply Hi ∘ blinfun_apply (H' (x, y)) = id"
using Hi by transfer auto
qed (use S blinfun.bounded_linear_right in auto)
then have g': "(G has_derivative Hi) (at (x, 0))"
by (auto simp: H_def assms)
show ?thesis
unfolding G_def[symmetric] H_def[symmetric]
apply (auto intro!: derivative_eq_intros)
apply (rule has_derivative_compose[where g=G and f="λx. (x, 0)"])
apply (auto intro!: g' derivative_eq_intros)
done
qed
done
moreover
note ‹r > 0›
moreover
define u where "u ≡ λx. snd (G (x, 0))"
have local_unique: "u s = v s"
if solves: "(⋀s. s ∈ U ⟹ f (s, v s) = 0)"
and i: "v x = y"
and v: "continuous_on U v"
and s: "s ∈ U"
and s': "(s, v s) ∈ ball (x, y) r"
and U: "U ⊆ cball x e"
for U v s
proof -
have H_eq: "H (s, v s) = H (s, u s)"
apply (auto simp: H_def solves[OF s])
unfolding u_def
apply (rule G2)
apply (rule subsetD; fact)
done
have "(s, snd (G (s, 0))) = (G (s, 0))"
using GH H_def s s' solves by fastforce
also have "… ∈ ball (x, y) r"
unfolding G_def
apply (rule the_inv_into_into)
apply fact
apply (rule u0)
apply (rule subsetD; fact)
apply (rule order_refl)
done
finally have "(s, u s) ∈ ball (x, y) r" unfolding u_def .
from inj_onD[OF inj H_eq s' this]
show "u s = v s"
by auto
qed
ultimately show ?thesis
unfolding u_def Hi' ..
qed
lemma implicit_function_theorem_unique:
fixes f::"'a::euclidean_space * 'b::euclidean_space ⇒ 'c::euclidean_space"
assumes f'[derivative_intros]: "⋀x. x ∈ S ⟹ (f has_derivative blinfun_apply (f' x)) (at x)"
assumes S: "(x, y) ∈ S" "open S"
assumes D: "DIM('c) ≤ DIM('b)"
assumes f'C: "continuous_on S f'"
assumes z: "f (x, y) = 0"
assumes T2: "T o⇩L (f' (x, y) o⇩L embed2_blinfun) = 1⇩L"
assumes T1: "(f' (x, y) o⇩L embed2_blinfun) o⇩L T = 1⇩L"
obtains u e
where "f (x, u x) = 0" "u x = y"
"⋀s. s ∈ cball x e ⟹ f (s, u s) = 0"
"continuous_on (cball x e) u"
"(λt. (t, u t)) ` cball x e ⊆ S"
"e > 0"
"(u has_derivative (- T o⇩L f' (x, y) o⇩L embed1_blinfun)) (at x)"
"⋀s. s ∈ cball x e ⟹ f' (s, u s) o⇩L embed2_blinfun ∈ invertibles_blinfun"
"⋀U v s. (⋀s. s ∈ U ⟹ f (s, v s) = 0) ⟹
u x = v x ⟹
continuous_on U v ⟹ s ∈ U ⟹ x ∈ U ⟹ U ⊆ cball x e ⟹ connected U ⟹ open U ⟹ u s = v s"
proof -
from T1 T2 have f'I: "f' (x, y) o⇩L embed2_blinfun ∈ invertibles_blinfun"
by (auto simp: invertibles_blinfun_def)
from assms have f'Cg: "s ∈ S ⟹ isCont f' s" for s
by (auto simp: continuous_on_eq_continuous_at[OF ‹open S›])
then have f'C: "isCont f' (x, y)" by (auto simp: S)
obtain u e1 r
where u: "f (x, u x) = 0" "u x = y"
"⋀s. s ∈ cball x e1 ⟹ f (s, u s) = 0"
"continuous_on (cball x e1) u"
"(λt. (t, u t)) ` cball x e1 ⊆ S"
"e1 > 0"
"(u has_derivative (- T o⇩L f' (x, y) o⇩L embed1_blinfun)) (at x)"
and unique_u: "r > 0"
"(⋀v s U. v x = y ⟹
(⋀s. s ∈ U ⟹ f (s, v s) = 0) ⟹
continuous_on U v ⟹ s ∈ U ⟹ U ⊆ cball x e1 ⟹ (s, v s) ∈ ball (x, y) r ⟹ u s = v s)"
by (rule implicit_function_theorem[OF f' S D f'C z T2 T1]; blast)
from openE[OF blinfun_inverse_open f'I] obtain d where d:
"0 < d" "ball (f' (x, y) o⇩L embed2_blinfun) d ⊆ invertibles_blinfun"
by auto
note [continuous_intros] = continuous_at_compose[OF _ f'Cg, unfolded o_def]
from ‹continuous_on _ u›
have "continuous_on (ball x e1) u" by (rule continuous_on_subset) auto
then have "⋀s. s ∈ ball x e1 ⟹ isCont u s"
unfolding continuous_on_eq_continuous_at[OF open_ball] by auto
note [continuous_intros] = continuous_at_compose[OF _ this, unfolded o_def]
from assms have f'Ce: "isCont (λs. f' (s, u s) o⇩L embed2_blinfun) x"
by (auto simp: u intro!: continuous_intros)
from f'Ce[unfolded isCont_def, THEN tendstoD, OF ‹0 < d›] d
obtain e0 where "e0 > 0" "⋀s. s ≠ x ⟹ s ∈ ball x e0 ⟹
(f' (s, u s) o⇩L embed2_blinfun) ∈ invertibles_blinfun"
by (auto simp: eventually_at dist_commute subset_iff u)
then have e0: "s ∈ ball x e0 ⟹ (f' (s, u s) o⇩L embed2_blinfun) ∈ invertibles_blinfun" for s
by (cases "s = x") (auto simp: f'I ‹0 < d› u)
define e where "e = min (e0/2) (e1/2)"
have e: "f (x, u x) = 0"
"u x = y"
"⋀s. s ∈ cball x e ⟹ f (s, u s) = 0"
"continuous_on (cball x e) u"
"(λt. (t, u t)) ` cball x e ⊆ S"
"e > 0"
"(u has_derivative (- T o⇩L f' (x, y) o⇩L embed1_blinfun)) (at x)"
"⋀s. s ∈ cball x e ⟹ f' (s, u s) o⇩L embed2_blinfun ∈ invertibles_blinfun"
using e0 u ‹e0 > 0› by (auto simp: e_def intro: continuous_on_subset)
from u(4) have "continuous_on (ball x e1) u"
apply (rule continuous_on_subset)
using ‹e1 > 0›
by (auto simp: e_def)
then have "⋀s. s ∈ cball x e ⟹ isCont u s"
using ‹e0 > 0› ‹e1 > 0›
unfolding continuous_on_eq_continuous_at[OF open_ball] by (auto simp: e_def Ball_def dist_commute)
note [continuous_intros] = continuous_at_compose[OF _ this, unfolded o_def]
have "u s = v s"
if solves: "(⋀s. s ∈ U ⟹ f (s, v s) = 0)"
and i: "u x = v x"
and v: "continuous_on U v"
and s: "s ∈ U" and U: "x ∈ U" "U ⊆ cball x e" "connected U" "open U"
for U v s
proof -
define M where "M = {s ∈ U. u s = v s}"
have "x ∈ M" using i U by (auto simp: M_def)
moreover
have "continuous_on U (λs. u s - v s)"
by (auto intro!: continuous_intros v continuous_on_subset[OF e(4) U(2)])
from continuous_closedin_preimage[OF this closed_singleton[where a=0]]
have "closedin (top_of_set U) M"
by (auto simp: M_def vimage_def Collect_conj_eq)
moreover
have "⋀s. s ∈ U ⟹ isCont v s"
using v
unfolding continuous_on_eq_continuous_at[OF ‹open U›] by auto
note [continuous_intros] = continuous_at_compose[OF _ this, unfolded o_def]
{
fix a assume "a ∈ M"
then have aU: "a ∈ U" and u_v: "u a = v a"
by (auto simp: M_def)
then have a_ball: "a ∈ cball x e" and a_dist: "dist x a ≤ e" using U by auto
then have a_S: "(a, u a) ∈ S"
using e by auto
have fa_z: "f (a, u a) = 0"
using ‹a ∈ cball x e› by (auto intro!: e)
from e(8)[OF ‹a ∈ cball _ _›]
obtain Ta where Ta: "Ta o⇩L (f' (a, u a) o⇩L embed2_blinfun) = 1⇩L" "f' (a, u a) o⇩L embed2_blinfun o⇩L Ta = 1⇩L"
by (auto simp: invertibles_blinfun_def ac_simps)
obtain u' e' r'
where "r' > 0" "e' > 0"
and u': "⋀v s U. v a = u a ⟹
(⋀s. s ∈ U ⟹ f (s, v s) = 0) ⟹
continuous_on U v ⟹ s ∈ U ⟹ U ⊆ cball a e' ⟹ (s, v s) ∈ ball (a, u a) r' ⟹ u' s = v s"
by (rule implicit_function_theorem[OF f' a_S ‹open S› D f'Cg[OF a_S] fa_z Ta]; blast)
from openE[OF ‹open U› aU] obtain dU where dU: "dU > 0" "⋀s. s ∈ ball a dU ⟹ s ∈ U"
by (auto simp: dist_commute subset_iff)
have v_tendsto: "((λs. (s, v s)) ⤏ (a, u a)) (at a)"
unfolding u_v
by (subst continuous_at[symmetric]) (auto intro!: continuous_intros aU)
from tendstoD[OF v_tendsto ‹0 < r'›, unfolded eventually_at]
obtain dv where "dv > 0" "s ≠ a ⟹ dist s a < dv ⟹ (s, v s) ∈ ball (a, u a) r'" for s
by (auto simp: dist_commute)
then have dv: "dist s a < dv ⟹ (s, v s) ∈ ball (a, u a) r'" for s
by (cases "s = a") (auto simp: u_v ‹0 < r'›)
have v_tendsto: "((λs. (s, u s)) ⤏ (a, u a)) (at a)"
using a_dist
by (subst continuous_at[symmetric]) (auto intro!: continuous_intros)
from tendstoD[OF v_tendsto ‹0 < r'›, unfolded eventually_at]
obtain du where "du > 0" "s ≠ a ⟹ dist s a < du ⟹ (s, u s) ∈ ball (a, u a) r'" for s
by (auto simp: dist_commute)
then have du: "dist s a < du ⟹ (s, u s) ∈ ball (a, u a) r'" for s
by (cases "s = a") (auto simp: u_v ‹0 < r'›)
{
fix s assume s: "s ∈ ball a (Min {dU, e', dv, du})"
let ?U = "ball a (Min {dU, e', dv, du})"
have balls: "ball a (Min {dU, e', dv, du}) ⊆ cball a e'" by auto
have dsadv: "dist s a < dv"
using s by (auto simp: dist_commute)
have dsadu: "dist s a < du"
using s by (auto simp: dist_commute)
have U_U: "⋀s. s ∈ ball a (Min {dU, e', dv, du}) ⟹ s ∈ U"
using dU by auto
have U_e: "⋀s. s ∈ ball a (Min {dU, e', dv, du}) ⟹ s ∈ cball x e"
using dU U by (auto simp: dist_commute subset_iff)
have cv: "continuous_on ?U v"
using v
apply (rule continuous_on_subset)
using dU
by auto
have cu: "continuous_on ?U u"
using e(4)
apply (rule continuous_on_subset)
using dU U(2)
by auto
from u'[where v=v, OF u_v[symmetric] solves[OF U_U] cv s balls dv[OF dsadv]]
u'[where v=u, OF refl e(3)[OF U_e] cu s balls du[OF dsadu]]
have "v s = u s" by auto
} then have "∃dv>0. ∀s ∈ ball a dv. v s = u s"
using ‹0 < dU› ‹0 < e'› ‹0 < dv› ‹0 < du›
by (auto intro!: exI[where x="(Min {dU, e', dv, du})"])
} note ex = this
have "openin (top_of_set U) M"
unfolding openin_contains_ball
apply (rule conjI)
subgoal using U by (auto simp: M_def)
apply (auto simp:)
apply (drule ex)
apply auto
subgoal for x d
by (rule exI[where x=d]) (auto simp: M_def)
done
ultimately have "M = U"
using ‹connected U›
by (auto simp: connected_clopen)
with ‹s ∈ U› show ?thesis by (auto simp: M_def)
qed
from e this
show ?thesis ..
qed
lemma uniform_limit_compose:
assumes ul: "uniform_limit T f l F"
assumes uc: "uniformly_continuous_on S s"
assumes ev: "∀⇩F x in F. f x ` T ⊆ S"
assumes subs: "l ` T ⊆ S"
shows "uniform_limit T (λi x. s (f i x)) (λx. s (l x)) F"
proof (rule uniform_limitI)
fix e::real assume "e > 0"
from uniformly_continuous_onE[OF uc ‹e > 0›]
obtain d where d: "0 < d" "⋀t t'. t ∈ S ⟹ t' ∈ S ⟹ dist t' t < d ⟹ dist (s t') (s t) < e"
by auto
from uniform_limitD[OF ul ‹0 < d›] have "∀⇩F n in F. ∀x∈T. dist (f n x) (l x) < d" .
then show "∀⇩F n in F. ∀x∈T. dist (s (f n x)) (s (l x)) < e"
using ev
by eventually_elim (use d subs in force)
qed
lemma
uniform_limit_in_open:
fixes l::"'a::topological_space⇒'b::heine_borel"
assumes ul: "uniform_limit T f l (at x)"
assumes cont: "continuous_on T l"
assumes compact: "compact T" and T_ne: "T ≠ {}"
assumes B: "open B"
assumes mem: "l ` T ⊆ B"
shows "∀⇩F y in at x. ∀t ∈ T. f y t ∈ B"
proof -
have l_ne: "l ` T ≠ {}" using T_ne by auto
have "compact (l ` T)"
by (auto intro!: compact_continuous_image cont compact)
from compact_in_open_separated[OF l_ne this B mem]
obtain e where "e > 0" "{x. infdist x (l ` T) ≤ e} ⊆ B"
by auto
from uniform_limitD[OF ul ‹0 < e›]
have "∀⇩F n in at x. ∀x∈T. dist (f n x) (l x) < e" .
then show ?thesis
proof eventually_elim
case (elim y)
show ?case
proof safe
fix t assume "t ∈ T"
have "infdist (f y t) (l ` T) ≤ dist (f y t) (l t)"
by (rule infdist_le) (use ‹t ∈ T› in auto)
also have "… < e" using elim ‹t ∈ T› by auto
finally have "infdist (f y t) (l ` T) ≤ e" by simp
then have "(f y t) ∈ {x. infdist x (l ` T) ≤ e}"
by (auto )
also note ‹… ⊆ B›
finally show "f y t ∈ B" .
qed
qed
qed
lemma
order_uniform_limitD1:
fixes l::"'a::topological_space⇒real"
assumes ul: "uniform_limit T f l (at x)"
assumes cont: "continuous_on T l"
assumes compact: "compact T"
assumes less: "⋀t. t ∈ T ⟹ l t < b"
shows "∀⇩F y in at x. ∀t ∈ T. f y t < b"
proof cases
assume ne: "T ≠ {}"
from compact_attains_sup[OF compact_continuous_image[OF cont compact], unfolded image_is_empty, OF ne]
obtain tmax where tmax: "tmax ∈ T" "⋀s. s ∈ T ⟹ l s ≤ l tmax"
by auto
have "b - l tmax > 0"
using ne tmax less by auto
from uniform_limitD[OF ul this]
have "∀⇩F n in at x. ∀x∈T. dist (f n x) (l x) < b - l tmax"
by auto
then show ?thesis
apply eventually_elim
using tmax
by (force simp: dist_real_def abs_real_def split: if_splits)
qed auto
lemma
order_uniform_limitD2:
fixes l::"'a::topological_space⇒real"
assumes ul: "uniform_limit T f l (at x)"
assumes cont: "continuous_on T l"
assumes compact: "compact T"
assumes less: "⋀t. t ∈ T ⟹ l t > b"
shows "∀⇩F y in at x. ∀t ∈ T. f y t > b"
proof -
have "∀⇩F y in at x. ∀t∈T. (- f) y t < - b"
by (rule order_uniform_limitD1[of "- f" T "-l" x "- b"])
(auto simp: assms fun_Compl_def intro!: uniform_limit_eq_intros continuous_intros)
then show ?thesis by auto
qed
lemma continuous_on_avoid_cases:
fixes l::"'b::topological_space ⇒ 'a::linear_continuum_topology"
assumes cont: "continuous_on T l" and conn: "connected T"
assumes avoid: "⋀t. t ∈ T ⟹ l t ≠ b"
obtains "⋀t. t ∈ T ⟹ l t < b" | "⋀t. t ∈ T ⟹ l t > b"
apply atomize_elim
using connected_continuous_image[OF cont conn] using avoid
unfolding connected_iff_interval
apply (auto simp: image_iff)
using leI by blast
lemma
order_uniform_limit_ne:
fixes l::"'a::topological_space⇒real"
assumes ul: "uniform_limit T f l (at x)"
assumes cont: "continuous_on T l"
assumes compact: "compact T" and conn: "connected T"
assumes ne: "⋀t. t ∈ T ⟹ l t ≠ b"
shows "∀⇩F y in at x. ∀t ∈ T. f y t ≠ b"
proof -
from continuous_on_avoid_cases[OF cont conn ne]
consider "(⋀t. t ∈ T ⟹ l t < b)" | "(⋀t. t ∈ T ⟹ l t > b)"
by blast
then show ?thesis
proof cases
case 1
from order_uniform_limitD1[OF ul cont compact 1]
have "∀⇩F y in at x. ∀t∈T. f y t < b" by simp
then show ?thesis
by eventually_elim auto
next
case 2
from order_uniform_limitD2[OF ul cont compact 2]
have "∀⇩F y in at x. ∀t∈T. f y t > b" by simp
then show ?thesis
by eventually_elim auto
qed
qed
lemma open_cballE:
assumes "open S" "x∈S"
obtains e where "e>0" "cball x e ⊆ S"
using assms unfolding open_contains_cball by auto
lemma pos_half_less: fixes x::real shows "x > 0 ⟹ x / 2 < x"
by auto
lemma closed_levelset: "closed {x. s x = (c::'a::t1_space)}" if "continuous_on UNIV s"
proof -
have "{x. s x = c} = s -` {c}" by auto
also have "closed …"
apply (rule closed_vimage)
apply (rule closed_singleton)
apply (rule that)
done
finally show ?thesis .
qed
lemma closed_levelset_within: "closed {x ∈ S. s x = (c::'a::t1_space)}" if "continuous_on S s" "closed S"
proof -
have "{x ∈ S. s x = c} = s -` {c} ∩ S" by auto
also have "closed …"
apply (rule continuous_on_closed_vimageI)
apply (rule that)
apply (rule that)
apply simp
done
finally show ?thesis .
qed
context c1_on_open_euclidean
begin
lemma open_existence_ivlE:
assumes "t ∈ existence_ivl0 x" "t ≥ 0"
obtains e where "e > 0" "cball x e × {0 .. t + e} ⊆ Sigma X existence_ivl0"
proof -
from assms have "(x, t) ∈ Sigma X existence_ivl0"
by auto
from open_cballE[OF open_state_space this]
obtain e0' where e0: "0 < e0'" "cball (x, t) e0' ⊆ Sigma X existence_ivl0"
by auto
define e0 where "e0 = (e0' / 2)"
from cball_times_subset[of x e0' t] pos_half_less[OF ‹0 < e0'›] half_gt_zero[OF ‹0 < e0'›] e0
have "cball x e0 × cball t e0 ⊆ Sigma X existence_ivl0" "0 < e0" "e0 < e0'"
unfolding e0_def by auto
then have "e0 > 0" "cball x e0 × {0..t + e0} ⊆ Sigma X existence_ivl0"
apply (auto simp: subset_iff dest!: spec[where x=t])
subgoal for a b
apply (rule in_existence_between_zeroI)
apply (drule spec[where x=a])
apply (drule spec[where x="t + e0"])
apply (auto simp: dist_real_def closed_segment_eq_real_ivl)
done
done
then show ?thesis ..
qed
lemmas [derivative_intros] = flow0_comp_has_derivative
lemma flow_isCont_state_space_comp[continuous_intros]:
"t x ∈ existence_ivl0 (s x) ⟹ isCont s x ⟹ isCont t x ⟹ isCont (λx. flow0 (s x) (t x)) x"
using continuous_within_compose3[where g="λ(x, t). flow0 x t"
and f="λx. (s x, t x)" and x = x and s = UNIV]
flow_isCont_state_space
by auto
lemma closed_plane[simp]: "closed {x. x ∙ i = c}"
using closed_hyperplane[of i c] by (auto simp: inner_commute)
lemma flow_tendsto_compose[tendsto_intros]:
assumes "(x ⤏ xs) F" "(t ⤏ ts) F"
assumes "ts ∈ existence_ivl0 xs"
shows "((λs. flow0 (x s) (t s)) ⤏ flow0 xs ts) F"
proof -
have ev: "∀⇩F s in F. (x s, t s) ∈ Sigma X existence_ivl0"
using tendsto_Pair[OF assms(1,2), THEN topological_tendstoD, OF open_state_space]
assms
by auto
show ?thesis
by (rule continuous_on_tendsto_compose[OF flow_continuous_on_state_space tendsto_Pair, unfolded split_beta' fst_conv snd_conv])
(use assms ev in auto)
qed
lemma returns_to_implicit_function:
fixes s::"'a::euclidean_space ⇒ real"
assumes rt: "returns_to {x ∈ S. s x = 0} x" (is "returns_to ?P x")
assumes cS: "closed S"
assumes Ds: "⋀x. (s has_derivative blinfun_apply (Ds x)) (at x)"
assumes DsC: "isCont Ds (poincare_map ?P x)"
assumes nz: "Ds (poincare_map ?P x) (f (poincare_map ?P x)) ≠ 0"
obtains u e
where "s (flow0 x (u x)) = 0"
"u x = return_time ?P x"
"(⋀y. y ∈ cball x e ⟹ s (flow0 y (u y)) = 0)"
"continuous_on (cball x e) u"
"(λt. (t, u t)) ` cball x e ⊆ Sigma X existence_ivl0"
"0 < e" "(u has_derivative (- blinfun_scaleR_left
(inverse (blinfun_apply (Ds (poincare_map ?P x)) (f (poincare_map ?P x)))) o⇩L
(Ds (poincare_map ?P x) o⇩L flowderiv x (return_time ?P x)) o⇩L embed1_blinfun)) (at x)"
proof -
note [derivative_intros] = has_derivative_compose[OF _ Ds]
have cont_s: "continuous_on UNIV s" by (rule has_derivative_continuous_on[OF Ds])
note cls[simp, intro] = closed_levelset[OF cont_s]
let ?t1 = "return_time ?P x"
have cls[simp, intro]: "closed {x ∈ S. s x = 0}"
by (rule closed_levelset_within) (auto intro!: cS continuous_on_subset[OF cont_s])
then have xt1: "(x, ?t1) ∈ Sigma X existence_ivl0"
by (auto intro!: return_time_exivl rt)
have D: "(⋀x. x ∈ Sigma X existence_ivl0 ⟹
((λ(x, t). s (flow0 x t)) has_derivative
blinfun_apply (Ds (flow0 (fst x) (snd x)) o⇩L (flowderiv (fst x) (snd x))))
(at x))"
by (auto intro!: derivative_eq_intros)
have C: "isCont (λx. Ds (flow0 (fst x) (snd x)) o⇩L flowderiv (fst x) (snd x))
(x, ?t1)"
using flowderiv_continuous_on[unfolded continuous_on_eq_continuous_within,
rule_format, OF xt1]
using at_within_open[OF xt1 open_state_space]
by (auto intro!: continuous_intros tendsto_eq_intros return_time_exivl rt
isCont_tendsto_compose[OF DsC, unfolded poincare_map_def]
simp: split_beta' isCont_def)
from return_time_returns[OF rt cls]
have Z: "(case (x, ?t1) of (x, t) ⇒ s (flow0 x t)) = 0"
by (auto simp: )
have I1: "blinfun_scaleR_left (inverse (Ds (flow0 x (?t1))(f (flow0 x (?t1))))) o⇩L
((Ds (flow0 (fst (x, return_time {x ∈ S. s x = 0} x))
(snd (x, return_time {x ∈ S. s x = 0} x))) o⇩L
flowderiv (fst (x, return_time {x ∈ S. s x = 0} x))
(snd (x, return_time {x ∈ S. s x = 0} x))) o⇩L
embed2_blinfun)
= 1⇩L"
using nz
by (auto intro!: blinfun_eqI
simp: rt flowderiv_def blinfun.bilinear_simps inverse_eq_divide poincare_map_def)
have I2: "((Ds (flow0 (fst (x, return_time {x ∈ S. s x = 0} x))
(snd (x, return_time {x ∈ S. s x = 0} x))) o⇩L
flowderiv (fst (x, return_time {x ∈ S. s x = 0} x))
(snd (x, return_time {x ∈ S. s x = 0} x))) o⇩L
embed2_blinfun) o⇩L blinfun_scaleR_left (inverse (Ds (flow0 x (?t1))(f (flow0 x (?t1)))))
= 1⇩L"
using nz
by (auto intro!: blinfun_eqI
simp: rt flowderiv_def blinfun.bilinear_simps inverse_eq_divide poincare_map_def)
show ?thesis
apply (rule implicit_function_theorem[where f="λ(x, t). s (flow0 x t)"
and S="Sigma X existence_ivl0", OF D xt1 open_state_space order_refl C Z I1 I2])
apply blast
unfolding split_beta' fst_conv snd_conv poincare_map_def[symmetric]
..
qed
lemma (in auto_ll_on_open) f_tendsto[tendsto_intros]:
assumes g1: "(g1 ⤏ b1) (at s within S)" and "b1 ∈ X"
shows "((λx. f (g1 x)) ⤏ f b1) (at s within S)"
apply (rule continuous_on_tendsto_compose[OF continuous tendsto_Pair[OF tendsto_const],
unfolded split_beta fst_conv snd_conv, OF g1])
by (auto simp: ‹b1 ∈ X› intro!: topological_tendstoD[OF g1])
lemma flow_avoids_surface_eventually_at_right_pos:
assumes "s x > 0 ∨ s x = 0 ∧ blinfun_apply (Ds x) (f x) > 0"
assumes x: "x ∈ X"
assumes Ds: "⋀x. (s has_derivative Ds x) (at x)"
assumes DsC: "⋀x. isCont Ds x"
shows "∀⇩F t in at_right 0. s (flow0 x t) > (0::real)"
proof -
have cont_s: "continuous_on UNIV s" by (rule has_derivative_continuous_on[OF Ds])
then have [THEN continuous_on_compose2, continuous_intros]: "continuous_on S s" for S by (rule continuous_on_subset) simp
note [derivative_intros] = has_derivative_compose[OF _ Ds]
note [tendsto_intros] = continuous_on_tendsto_compose[OF cont_s]
isCont_tendsto_compose[OF DsC]
from assms(1)
consider "s x > 0" | "s x = 0" "blinfun_apply (Ds x) (f x) > 0"
by auto
then show ?thesis
proof cases
assume s: "s x > 0"
then have "((λt. s (flow0 x t)) ⤏ s x) (at_right 0)"
by (auto intro!: tendsto_eq_intros simp: split_beta' x)
from order_tendstoD(1)[OF this s]
show ?thesis .
next
assume sz: "s x = 0" and pos: "blinfun_apply (Ds x) (f x) > 0"
from x have "0 ∈ existence_ivl0 x" "open (existence_ivl0 x)" by simp_all
then have evex: "∀⇩F t in at_right 0. t ∈ existence_ivl0 x"
using eventually_at_topological by blast
moreover
from evex have "∀⇩F xa in at_right 0. flow0 x xa ∈ X"
by (eventually_elim) (auto intro!: )
then have "((λt. (Ds (flow0 x t)) (f (flow0 x t))) ⤏ blinfun_apply (Ds x) (f x)) (at_right 0)"
by (auto intro!: tendsto_eq_intros simp: split_beta' x)
from order_tendstoD(1)[OF this pos]
have "∀⇩F z in at_right 0. blinfun_apply (Ds (flow0 x z)) (f (flow0 x z)) > 0" .
then obtain t where t: "t > 0" "⋀z. 0 < z ⟹ z < t ⟹ blinfun_apply (Ds (flow0 x z)) (f (flow0 x z)) > 0"
by (auto simp: eventually_at)
have "∀⇩F z in at_right 0. z < t" using ‹t > 0› order_tendstoD(2)[OF tendsto_ident_at ‹0 < t›] by auto
moreover have "∀⇩F z in at_right 0. 0 < z" by (simp add: eventually_at_filter)
ultimately show ?thesis
proof eventually_elim
case (elim z)
from closed_segment_subset_existence_ivl[OF ‹z ∈ existence_ivl0 x›]
have csi: "{0..z} ⊆ existence_ivl0 x" by (auto simp add: closed_segment_eq_real_ivl)
then have cont: "continuous_on {0..z} (λt. s (flow0 x t))"
by (auto intro!: continuous_intros)
have "⋀u. ⟦0 < u; u < z⟧ ⟹ ((λt. s (flow0 x t)) has_derivative (λt. t * blinfun_apply (Ds (flow0 x u)) (f (flow0 x u)))) (at u)"
using csi
by (auto intro!: derivative_eq_intros simp: flowderiv_def blinfun.bilinear_simps)
from mvt[OF ‹0 < z› cont this]
obtain w where w: "0 < w" "w < z" and sDs: "s (flow0 x z) = z * blinfun_apply (Ds (flow0 x w)) (f (flow0 x w))"
using x sz
by auto
note sDs
also have "… > 0"
using elim t(2)[of w] w by simp
finally show ?case .
qed
qed
qed
lemma flow_avoids_surface_eventually_at_right_neg:
assumes "s x < 0 ∨ s x = 0 ∧ blinfun_apply (Ds x) (f x) < 0"
assumes x: "x ∈ X"
assumes Ds: "⋀x. (s has_derivative Ds x) (at x)"
assumes DsC: "⋀x. isCont Ds x"
shows "∀⇩F t in at_right 0. s (flow0 x t) < (0::real)"
apply (rule flow_avoids_surface_eventually_at_right_pos[of "-s" x "-Ds", simplified])
using assms
by (auto intro!: derivative_eq_intros simp: blinfun.bilinear_simps fun_Compl_def)
lemma flow_avoids_surface_eventually_at_right:
assumes "x ∉ S ∨ s x ≠ 0 ∨ blinfun_apply (Ds x) (f x) ≠ 0"
assumes x: "x ∈ X" and cS: "closed S"
assumes Ds: "⋀x. (s has_derivative Ds x) (at x)"
assumes DsC: "⋀x. isCont Ds x"
shows "∀⇩F t in at_right 0. (flow0 x t) ∉ {x ∈ S. s x = (0::real)}"
proof -
from assms(1)
consider
"s x > 0 ∨ s x = 0 ∧ blinfun_apply (Ds x) (f x) > 0"
| "s x < 0 ∨ s x = 0 ∧ blinfun_apply (Ds x) (f x) < 0"
| "x ∉ S"
by arith
then show ?thesis
proof cases
case 1
from flow_avoids_surface_eventually_at_right_pos[of s x Ds, OF 1 x Ds DsC]
show ?thesis by eventually_elim auto
next
case 2
from flow_avoids_surface_eventually_at_right_neg[of s x Ds, OF 2 x Ds DsC]
show ?thesis by eventually_elim auto
next
case 3
then have nS: "open (- S)" "x ∈ - S" using cS by auto
have "∀⇩F t in at_right 0. (flow0 x t) ∈ - S"
by (rule topological_tendstoD[OF _ nS]) (auto intro!: tendsto_eq_intros simp: x)
then show ?thesis by eventually_elim auto
qed
qed
lemma eventually_returns_to:
fixes s::"'a::euclidean_space ⇒ real"
assumes rt: "returns_to {x ∈ S. s x = 0} x" (is "returns_to ?P x")
assumes cS: "closed S"
assumes Ds: "⋀x. (s has_derivative blinfun_apply (Ds x)) (at x)"
assumes DsC: "⋀x. isCont Ds x"
assumes eventually_inside: "∀⇩F x in at (poincare_map ?P x). s x = 0 ⟶ x ∈ S"
assumes nz: "Ds (poincare_map ?P x) (f (poincare_map ?P x)) ≠ 0"
assumes nz0: "x ∉ S ∨ s x ≠ 0 ∨ Ds x (f x) ≠ 0"
shows "∀⇩F x in at x. returns_to ?P x"
proof -
let ?t1 = "return_time ?P x"
have cont_s: "continuous_on UNIV s" by (rule has_derivative_continuous_on[OF Ds])
have cont_s': "continuous_on S s" for S by (rule continuous_on_subset[OF cont_s subset_UNIV])
note s_tendsto[tendsto_intros] = continuous_on_tendsto_compose[OF cont_s, THEN tendsto_eq_rhs]
note cls[simp, intro] = closed_levelset_within[OF cont_s' cS, of 0]
note [tendsto_intros] = continuous_on_tendsto_compose[OF cont_s]
isCont_tendsto_compose[OF DsC]
obtain u e
where "s (flow0 x (u x)) = 0"
"u x = return_time ?P x"
"(⋀y. y ∈ cball x e ⟹ s (flow0 y (u y)) = 0)"
"continuous_on (cball x e) u"
"(λt. (t, u t)) ` cball x e ⊆ Sigma X existence_ivl0"
"0 < e"
by (rule returns_to_implicit_function[OF rt cS Ds DsC nz]; blast)
then have u:
"s (flow0 x (u x)) = 0" "u x = ?t1"
"(⋀y. y ∈ cball x e ⟹ s (flow0 y (u y)) = 0)"
"continuous_on (cball x e) u"
"⋀z. z ∈ cball x e ⟹ u z ∈ existence_ivl0 z"
"e > 0"
by (force simp: split_beta')+
have "∀⇩F y in at x. y ∈ ball x e"
using eventually_at_ball[OF ‹0 < e›]
by eventually_elim auto
then have ev_cball: "∀⇩F y in at x. y ∈ cball x e"
by eventually_elim (use ‹e > 0› in auto)
moreover
have "continuous_on (ball x e) u"
using u by (auto simp: continuous_on_subset)
then have [tendsto_intros]: "(u ⤏ u x) (at x)"
using ‹e > 0› at_within_open[of y "ball x e" for y]
by (auto simp: continuous_on_def)
then have flow0_u_tendsto: "(λx. flow0 x (u x)) ─x→ poincare_map ?P x"
by (auto intro!: tendsto_eq_intros u return_time_exivl rt simp: poincare_map_def)
have s_imp: "s (poincare_map {x ∈ S. s x = 0} x) = 0 ⟶ poincare_map {x ∈ S. s x = 0} x ∈ S"
using poincare_map_returns[OF rt]
by auto
from eventually_tendsto_compose_within[OF eventually_inside s_imp flow0_u_tendsto]
have "∀⇩F x in at x. s (flow0 x (u x)) = 0 ⟶ flow0 x (u x) ∈ S" by auto
with ev_cball
have "∀⇩F x in at x. flow0 x (u x) ∈ S"
by eventually_elim (auto simp: u)
moreover
{
have "x ∈ X"
using u(5) u(6) by force
from ev_cball
have ev_X: "∀⇩F y in at x. y ∈ X"
apply eventually_elim
apply (rule)
by (rule u)
moreover
{
{
assume a: "x ∉ S" then have "open (-S)" "x ∈ - S" using cS by auto
from topological_tendstoD[OF tendsto_ident_at this]
have "(∀⇩F y in at x. y ∉ S)" by auto
} moreover {
assume a: "s x ≠ 0"
have "(∀⇩F y in at x. s y ≠ 0)"
by (rule tendsto_imp_eventually_ne[OF _ a]) (auto intro!: tendsto_eq_intros)
} moreover {
assume a: "(Ds x) (f x) ≠ 0"
have "(∀⇩F y in at x. blinfun_apply (Ds y) (f y) ≠ 0)"
by (rule tendsto_imp_eventually_ne[OF _ a]) (auto intro!: tendsto_eq_intros ev_X ‹x ∈ X›)
} ultimately have "(∀⇩F y in at x. y ∉ S) ∨ (∀⇩F y in at x. s y ≠ 0) ∨ (∀⇩F y in at x. blinfun_apply (Ds y) (f y) ≠ 0)"
using nz0 by auto
then have "∀⇩F y in at x. y ∉ S ∨ s y ≠ 0 ∨ blinfun_apply (Ds y) (f y) ≠ 0"
apply -
apply (erule disjE)
subgoal by (rule eventually_elim2, assumption, assumption, blast)
subgoal
apply (erule disjE)
subgoal by (rule eventually_elim2, assumption, assumption, blast)
subgoal by (rule eventually_elim2, assumption, assumption, blast)
done
done
}
ultimately
have "∀⇩F y in at x. (y ∉ S ∨ s y ≠ 0 ∨ blinfun_apply (Ds y) (f y) ≠ 0) ∧ y ∈ X"
by eventually_elim auto
}
then have "∀⇩F y in at x. ∀⇩F t in at_right 0. flow0 y t ∉ {x ∈ S. s x = 0}"
apply eventually_elim
by (rule flow_avoids_surface_eventually_at_right[where Ds=Ds]) (auto intro!: Ds DsC cS)
moreover
have at_eq: "(at x within cball x e) = at x"
apply (rule at_within_interior)
apply (auto simp: ‹e > 0›)
done
have "u x > 0"
using u(1) by (auto simp: u rt cont_s' intro!: return_time_pos closed_levelset_within cS)
then have "∀⇩F y in at x. u y > 0"
apply (rule order_tendstoD[rotated])
using u(4)
apply (auto simp: continuous_on_def)
apply (drule bspec[where x=x])
using ‹e > 0›
by (auto simp: at_eq)
ultimately
show "∀⇩F y in at x. returns_to ?P y"
apply eventually_elim
subgoal premises prems for y
apply (rule returns_toI[where t="u y"])
subgoal using prems by auto
subgoal apply (rule u) apply (rule prems) done
subgoal using u(3)[of y] prems by auto
subgoal using prems(3) by eventually_elim auto
subgoal by simp
done
done
qed
lemma
return_time_isCont_outside:
fixes s::"'a::euclidean_space ⇒ real"
assumes rt: "returns_to {x ∈ S. s x = 0} x" (is "returns_to ?P x")
assumes cS: "closed S"
assumes Ds: "⋀x. (s has_derivative blinfun_apply (Ds x)) (at x)"
assumes DsC: "⋀x. isCont Ds x"
assumes through: "(Ds (poincare_map ?P x)) (f (poincare_map ?P x)) ≠ 0"
assumes eventually_inside: "∀⇩F x in at (poincare_map ?P x). s x = 0 ⟶ x ∈ S"
assumes outside: "x ∉ S ∨ s x ≠ 0"
shows "isCont (return_time ?P) x"
unfolding isCont_def
proof (rule tendstoI)
fix e_orig::real assume "e_orig > 0"
define e where "e = e_orig / 2"
have "e > 0" using ‹e_orig > 0› by (simp add: e_def)
have cont_s: "continuous_on UNIV s" by (rule has_derivative_continuous_on[OF Ds])
then have s_tendsto: "(s ⤏ s x) (at x)" for x
by (auto simp: continuous_on_def)
have cont_s': "continuous_on S s" by (rule continuous_on_subset[OF cont_s subset_UNIV])
note cls[simp, intro] = closed_levelset_within[OF cont_s' cS(1)]
have "{x. s x = 0} = s -` {0}" by auto
have ret_exivl: "return_time ?P x ∈ existence_ivl0 x"
by (rule return_time_exivl; fact)
then have [intro, simp]: "x ∈ X" by auto
have isCont_Ds_f: "isCont (λs. Ds s (f s)) (poincare_map ?P x)"
apply (auto intro!: continuous_intros DsC)
apply (rule has_derivative_continuous)
apply (rule derivative_rhs)
by (auto simp: poincare_map_def intro!: flow_in_domain return_time_exivl assms)
obtain u eu where u:
"s (flow0 x (u x)) = 0"
"u x = return_time ?P x"
"(⋀y. y ∈ cball x eu ⟹ s (flow0 y (u y)) = 0)"
"continuous_on (cball x eu) u"
"(λt. (t, u t)) ` cball x eu ⊆ Sigma X existence_ivl0"
"0 < eu"
by (rule returns_to_implicit_function[OF rt cS(1) Ds DsC through]; blast)
have u_tendsto: "(u ⤏ u x) (at x)"
unfolding isCont_def[symmetric]
apply (rule continuous_on_interior[OF u(4)])
using ‹0 < eu› by auto
have "u x > 0" by (auto simp: u intro!: return_time_pos rt)
from order_tendstoD(1)[OF u_tendsto this] have "∀⇩F x in at x. 0 < u x" .
moreover have "∀⇩F y in at x. y ∈ cball x eu"
using eventually_at_ball[OF ‹0 < eu›, of x]
by eventually_elim auto
moreover
have "x ∉ S ∨ s x ≠ 0 ∨ blinfun_apply (Ds x) (f x) ≠ 0" using outside by auto
have returns: "∀⇩F y in at x. returns_to ?P y"
by (rule eventually_returns_to; fact)
moreover
have "∀⇩F y in at x. y ∈ ball x eu"
using eventually_at_ball[OF ‹0 < eu›]
by eventually_elim simp
then have ev_cball: "∀⇩F y in at x. y ∈ cball x eu"
by eventually_elim (use ‹e > 0› in auto)
have "continuous_on (ball x eu) u"
using u by (auto simp: continuous_on_subset)
then have [tendsto_intros]: "(u ⤏ u x) (at x)"
using ‹eu > 0› at_within_open[of y "ball x eu" for y]
by (auto simp: continuous_on_def)
then have flow0_u_tendsto: "(λx. flow0 x (u x)) ─x→ poincare_map ?P x"
by (auto intro!: tendsto_eq_intros u return_time_exivl rt simp: poincare_map_def)
have s_imp: "s (poincare_map {x ∈ S. s x = 0} x) = 0 ⟶ poincare_map {x ∈ S. s x = 0} x ∈ S"
using poincare_map_returns[OF rt]
by auto
from eventually_tendsto_compose_within[OF eventually_inside s_imp flow0_u_tendsto]
have "∀⇩F x in at x. s (flow0 x (u x)) = 0 ⟶ flow0 x (u x) ∈ S" by auto
with ev_cball
have "∀⇩F x in at x. flow0 x (u x) ∈ S"
by eventually_elim (auto simp: u)
ultimately have u_returns_ge: "∀⇩F y in at x. returns_to ?P y ∧ return_time ?P y ≤ u y"
proof eventually_elim
case (elim y)
then show ?case
using u elim by (auto intro!: return_time_le[OF _ cls])
qed
moreover
have "∀⇩F y in at x. u y - return_time ?P x < e"
using tendstoD[OF u_tendsto ‹0 < e›, unfolded u] u_returns_ge
by eventually_elim (auto simp: dist_real_def)
moreover
note 1 = outside
define ml where "ml = max (return_time ?P x / 2) (return_time ?P x - e)"
have [intro, simp, arith]: "0 < ml" "ml < return_time ?P x" "ml ≤ return_time ?P x"
using return_time_pos[OF rt cls] ‹0 < e›
by (auto simp: ml_def)
have mt_in: "ml ∈ existence_ivl0 x"
using ‹0 < e›
by (auto intro!: mem_existence_ivl_iv_defined in_existence_between_zeroI[OF ret_exivl]
simp: closed_segment_eq_real_ivl ml_def)
from open_existence_ivlE[OF mt_in]
obtain e0 where e0: "e0 > 0" "cball x e0 × {0..ml + e0} ⊆ Sigma X existence_ivl0" (is "?D ⊆ _")
by auto
have uc: "uniformly_continuous_on ((λ(x, t). flow0 x t) ` ?D) s"
apply (auto intro!: compact_uniformly_continuous continuous_on_subset[OF cont_s])
apply (rule compact_continuous_image)
apply (rule continuous_on_subset)
apply (rule flow_continuous_on_state_space)
apply (rule e0)
apply (rule compact_Times)
apply (rule compact_cball)
apply (rule compact_Icc)
done
let ?T = "{0..ml}"
have ul: "uniform_limit ?T flow0 (flow0 x) (at x)"
using ‹0 < e›
by (intro uniform_limit_flow)
(auto intro!: mem_existence_ivl_iv_defined in_existence_between_zeroI[OF ret_exivl]
simp: closed_segment_eq_real_ivl )
have "∀⇩F y in at x. ∀t∈{0..ml}. flow0 y t ∈ - {x ∈ S. s x = 0}"
apply (rule uniform_limit_in_open)
apply (rule ul)
apply (auto intro!: continuous_intros continuous_on_compose2[OF cont_s] simp:
split: if_splits)
apply (meson atLeastAtMost_iff contra_subsetD local.ivl_subset_existence_ivl mt_in)
subgoal for t
apply (cases "t = 0")
subgoal using 1 by (simp)
subgoal
using return_time_least[OF rt cls, of t] ‹ml < return_time {x ∈ S. s x = 0} x›
by auto
done
done
then have "∀⇩F y in at x. return_time ?P y ≥ return_time ?P x - e"
using u_returns_ge
proof eventually_elim
case (elim y)
have "return_time ?P x - e ≤ ml"
by (auto simp: ml_def)
also
have ry: "returns_to ?P y" "return_time ?P y ≤ u y"
using elim
by auto
have "ml < return_time ?P y"
apply (rule return_time_gt[OF ry(1) cls])
using elim
by (auto simp: Ball_def)
finally show ?case by simp
qed
ultimately
have "∀⇩F y in at x. dist (return_time ?P y) (return_time ?P x) ≤ e"
by eventually_elim (auto simp: dist_real_def abs_real_def algebra_simps)
then show "∀⇩F y in at x. dist (return_time ?P y) (return_time ?P x) < e_orig"
by eventually_elim (use ‹e_orig > 0› in ‹auto simp: e_def›)
qed
lemma isCont_poincare_map:
assumes "isCont (return_time P) x"
"returns_to P x" "closed P"
shows "isCont (poincare_map P) x"
unfolding poincare_map_def
by (auto intro!: continuous_intros assms return_time_exivl)
lemma poincare_map_tendsto:
assumes "(return_time P ⤏ return_time P x) (at x within S)"
"returns_to P x" "closed P"
shows "(poincare_map P ⤏ poincare_map P x) (at x within S)"
unfolding poincare_map_def
by (rule tendsto_eq_intros refl assms return_time_exivl)+
lemma
return_time_continuous_below:
fixes s::"'a::euclidean_space ⇒ real"
assumes rt: "returns_to {x ∈ S. s x = 0} x" (is "returns_to ?P x")
assumes Ds: "⋀x. (s has_derivative blinfun_apply (Ds x)) (at x)"
assumes cS: "closed S"
assumes eventually_inside: "∀⇩F x in at (poincare_map ?P x). s x = 0 ⟶ x ∈ S"
assumes DsC: "⋀x. isCont Ds x"
assumes through: "(Ds (poincare_map ?P x)) (f (poincare_map ?P x)) ≠ 0"
assumes inside: "x ∈ S" "s x = 0" "Ds x (f x) < 0"
shows "continuous (at x within {x. s x ≤ 0}) (return_time ?P)"
unfolding continuous_within
proof (rule tendstoI)
fix e_orig::real assume "e_orig > 0"
define e where "e = e_orig / 2"
have "e > 0" using ‹e_orig > 0› by (simp add: e_def)
note DsC_tendso[tendsto_intros] = isCont_tendsto_compose[OF DsC]
have cont_s: "continuous_on UNIV s" by (rule has_derivative_continuous_on[OF Ds])
then have s_tendsto: "(s ⤏ s x) (at x)" for x
by (auto simp: continuous_on_def)
note [continuous_intros] = continuous_on_compose2[OF cont_s _ subset_UNIV]
note [derivative_intros] = has_derivative_compose[OF _ Ds]
have cont_s': "continuous_on S s" by (rule continuous_on_subset[OF cont_s subset_UNIV])
note cls[simp, intro] = closed_levelset_within[OF cont_s' cS(1)]
have "{x. s x = 0} = s -` {0}" by auto
have ret_exivl: "return_time ?P x ∈ existence_ivl0 x"
by (rule return_time_exivl; fact)
then have [intro, simp]: "x ∈ X" by auto
have isCont_Ds_f: "isCont (λs. Ds s (f s)) (poincare_map ?P x)"
apply (auto intro!: continuous_intros DsC)
apply (rule has_derivative_continuous)
apply (rule derivative_rhs)
by (auto simp: poincare_map_def intro!: flow_in_domain return_time_exivl assms)
have "∀⇩F yt in at (x, 0) within UNIV × {0<..}. (Ds (flow0 (fst yt) (snd yt))) (f (flow0 (fst yt) (snd yt))) < 0"
by (rule order_tendstoD) (auto intro!: tendsto_eq_intros inside)
moreover
have "(x, 0) ∈ Sigma X existence_ivl0" by auto
from topological_tendstoD[OF tendsto_ident_at open_state_space this, of "UNIV × {0<..}"]
have "∀⇩F yt in at (x, 0) within UNIV × {0<..}. snd yt ∈ existence_ivl0 (fst yt)"
by eventually_elim auto
moreover
from topological_tendstoD[OF tendsto_ident_at open_Times[OF open_dom open_UNIV], of "(x, 0)" "UNIV × {0<..}"]
have "∀⇩F yt in at (x, 0) within UNIV × {0<..}. fst yt ∈ X"
by (auto simp: mem_Times_iff)
ultimately
have "∀⇩F yt in at (x, 0) within UNIV × {0<..}. (Ds (flow0 (fst yt) (snd yt))) (f (flow0 (fst yt) (snd yt))) < 0 ∧
snd yt ∈ existence_ivl0 (fst yt) ∧
0 ∈ existence_ivl0 (fst yt)"
by eventually_elim auto
then obtain d2 where "0 < d2" and
d2_neg: "⋀y t. (y, t) ∈ cball (x, 0) d2 ⟹ 0 < t ⟹ (Ds (flow0 y t)) (f (flow0 y t)) < 0"
and d2_ex: "⋀y t. (y, t) ∈ cball (x, 0) d2 ⟹ 0 < t ⟹ t ∈ existence_ivl0 y"
and d2_ex0: "⋀y t. (y, t::real) ∈ cball (x, 0) d2 ⟹ 0 < t ⟹ y ∈ X"
by (auto simp: eventually_at_le dist_commute)
define d where "d ≡ d2 / 2"
from ‹0 < d2› have "d > 0" by (simp add: d_def)
have d_neg: "dist y x< d ⟹ 0 < t ⟹ t ≤ d ⟹ (Ds (flow0 y t)) (f (flow0 y t)) < 0" for y t
using d2_neg[of y t, OF subsetD[OF cball_times_subset[of x d2 0]]]
by (auto simp: d_def dist_commute)
have d_ex: "t ∈ existence_ivl0 y" if "dist y x< d" "0 ≤ t" "t ≤ d" for y t
proof cases
assume "t = 0"
have "sqrt ((dist x y)⇧2 + (d2 / 2)⇧2) ≤ dist x y + d2/2"
using ‹0 < d2›
by (intro sqrt_sum_squares_le_sum) auto
also have "dist x y ≤ d2 / 2"
using that by (simp add: d_def dist_commute)
finally have "sqrt ((dist x y)⇧2 + (d2 / 2)⇧2) ≤ d2" by simp
with ‹t = 0› show ?thesis
using d2_ex[of y t, OF subsetD[OF cball_times_subset[of x d2 0]]] d2_ex0[of y d] ‹0 < d2›
by (auto simp: d_def dist_commute dist_prod_def)
next
assume "t ≠ 0"
then show ?thesis
using d2_ex[of y t, OF subsetD[OF cball_times_subset[of x d2 0]]] that
by (auto simp: d_def dist_commute)
qed
have d_mvt: "s (flow0 y t) < s y" if "0 < t" "t ≤ d" "dist y x < d" for y t
proof -
have c: "continuous_on {0 .. t} (λt. s (flow0 y t))"
using that
by (auto intro!: continuous_intros d_ex)
have d: "⋀x. ⟦0 < x; x < t⟧ ⟹ ((λt. s (flow0 y t)) has_derivative (λt. t * blinfun_apply (Ds (flow0 y x)) (f (flow0 y x)))) (at x)"
using that
by (auto intro!: derivative_eq_intros d_ex simp: flowderiv_def blinfun.bilinear_simps)
from mvt[OF ‹0 < t› c d]
obtain xi where xi: "0 < xi" "xi < t" and "s (flow0 y t) - s (flow0 y 0) = t * blinfun_apply (Ds (flow0 y xi)) (f (flow0 y xi))"
by auto
note this(3)
also have "… < 0"
using ‹0 < t›
apply (rule mult_pos_neg)
apply (rule d_neg)
using that xi by auto
also have "flow0 y 0 = y"
apply (rule flow_initial_time)
apply auto
using ‹0 < d› d_ex that(3) by fastforce
finally show ?thesis
by (auto simp: )
qed
obtain u eu where u:
"s (flow0 x (u x)) = 0"
"u x = return_time ?P x"
"(⋀y. y ∈ cball x eu ⟹ s (flow0 y (u y)) = 0)"
"continuous_on (cball x eu) u"
"(λt. (t, u t)) ` cball x eu ⊆ Sigma X existence_ivl0"
"0 < eu"
by (rule returns_to_implicit_function[OF rt cS(1) Ds DsC through]; blast)
have u_tendsto: "(u ⤏ u x) (at x)"
unfolding isCont_def[symmetric]
apply (rule continuous_on_interior[OF u(4)])
using ‹0 < eu› by auto
have "u x > 0" by (auto simp: u intro!: return_time_pos rt)
from order_tendstoD(1)[OF u_tendsto this] have "∀⇩F x in at x. 0 < u x" .
moreover have "∀⇩F y in at x. y ∈ cball x eu"
using eventually_at_ball[OF ‹0 < eu›, of x]
by eventually_elim auto
moreover
have "x ∉ S ∨ s x ≠ 0 ∨ blinfun_apply (Ds x) (f x) ≠ 0" using inside by auto
have returns: "∀⇩F y in at x. returns_to ?P y"
by (rule eventually_returns_to; fact)
moreover
have "∀⇩F y in at x. y ∈ ball x eu"
using eventually_at_ball[OF ‹0 < eu›]
by eventually_elim simp
then have ev_cball: "∀⇩F y in at x. y ∈ cball x eu"
by eventually_elim (use ‹e > 0› in auto)
have "continuous_on (ball x eu) u"
using u by (auto simp: continuous_on_subset)
then have [tendsto_intros]: "(u ⤏ u x) (at x)"
using ‹eu > 0› at_within_open[of y "ball x eu" for y]
by (auto simp: continuous_on_def)
then have flow0_u_tendsto: "(λx. flow0 x (u x)) ─x→ poincare_map ?P x"
by (auto intro!: tendsto_eq_intros u return_time_exivl rt simp: poincare_map_def)
have s_imp: "s (poincare_map {x ∈ S. s x = 0} x) = 0 ⟶ poincare_map {x ∈ S. s x = 0} x ∈ S"
using poincare_map_returns[OF rt]
by auto
from eventually_tendsto_compose_within[OF eventually_inside s_imp flow0_u_tendsto]
have "∀⇩F x in at x. s (flow0 x (u x)) = 0 ⟶ flow0 x (u x) ∈ S" by auto
with ev_cball
have "∀⇩F x in at x. flow0 x (u x) ∈ S"
by eventually_elim (auto simp: u)
ultimately have u_returns_ge: "∀⇩F y in at x. returns_to ?P y ∧ return_time ?P y ≤ u y"
proof eventually_elim
case (elim y)
then show ?case
using u elim by (auto intro!: return_time_le[OF _ cls])
qed
moreover
have "∀⇩F y in at x. u y - return_time ?P x < e"
using tendstoD[OF u_tendsto ‹0 < e›, unfolded u] u_returns_ge
by eventually_elim (auto simp: dist_real_def)
moreover
have d_less: "d < return_time ?P x"
apply (rule return_time_gt)
apply fact apply fact
subgoal for t
using d_mvt[of t x] ‹s x = 0› ‹0 < d›
by auto
done
note 1 = inside
define ml where "ml = Max {return_time ?P x / 2, return_time ?P x - e, d}"
have [intro, simp, arith]: "0 < ml" "ml < return_time ?P x" "ml ≤ return_time ?P x" "d ≤ ml"
using return_time_pos[OF rt cls] ‹0 < e› d_less
by (auto simp: ml_def)
have mt_in: "ml ∈ existence_ivl0 x"
using ‹0 < e› ‹0 < d› d_less
by (auto intro!: mem_existence_ivl_iv_defined in_existence_between_zeroI[OF ret_exivl]
simp: closed_segment_eq_real_ivl ml_def)
from open_existence_ivlE[OF mt_in]
obtain e0 where e0: "e0 > 0" "cball x e0 × {0..ml + e0} ⊆ Sigma X existence_ivl0" (is "?D ⊆ _")
by auto
have uc: "uniformly_continuous_on ((λ(x, t). flow0 x t) ` ?D) s"
apply (auto intro!: compact_uniformly_continuous continuous_on_subset[OF cont_s])
apply (rule compact_continuous_image)
apply (rule continuous_on_subset)
apply (rule flow_continuous_on_state_space)
apply (rule e0)
apply (rule compact_Times)
apply (rule compact_cball)
apply (rule compact_Icc)
done
let ?T = "{d..ml}"
have ul: "uniform_limit ?T flow0 (flow0 x) (at x)"
using ‹0 < e› ‹0 < d› d_less
by (intro uniform_limit_flow)
(auto intro!: mem_existence_ivl_iv_defined in_existence_between_zeroI[OF ret_exivl]
simp: closed_segment_eq_real_ivl )
{
have "∀⇩F y in at x within {x. s x ≤ 0}. y ∈ X"
by (rule topological_tendstoD[OF tendsto_ident_at open_dom ‹x ∈ X›])
moreover
have "∀⇩F y in at x within {x. s x ≤ 0}. s y ≤ 0"
by (auto simp: eventually_at)
moreover
have "∀⇩F y in at x within {x. s x ≤ 0}. Ds y (f y) < 0"
by (rule order_tendstoD) (auto intro!: tendsto_eq_intros inside)
moreover
from tendstoD[OF tendsto_ident_at ‹0 < d›]
have "∀⇩F y in at x within {x. s x ≤ 0}. dist y x < d"
by (auto simp: )
moreover
have "d ∈ existence_ivl0 x"
using d_ex[of x d] ‹0 < d› by auto
have dret: "returns_to {x∈S. s x = 0} (flow0 x d)"
apply (rule returns_to_laterI)
apply fact+
subgoal for u
using d_mvt[of u x] ‹s x = 0›
by auto
done
have "∀⇩F y in at x. ∀t∈{d..ml}. flow0 y t ∈ - {x ∈ S. s x = 0}"
apply (rule uniform_limit_in_open)
apply (rule ul)
apply (auto intro!: continuous_intros continuous_on_compose2[OF cont_s] simp:
split: if_splits)
using ‹d ∈ existence_ivl0 x› mem_is_interval_1_I mt_in apply blast
subgoal for t
using return_time_least[OF rt cls, of t] ‹ml < return_time {x ∈ S. s x = 0} x› ‹0 < d›
by auto
done
then have "∀⇩F y in at x within {x. s x ≤ 0}. ∀t∈{d .. ml}. flow0 y t ∈ - {x ∈ S. s x = 0}"
by (auto simp add: eventually_at; force)
ultimately
have "∀⇩F y in at x within {x. s x ≤ 0}. ∀t∈{0<..ml}. flow0 y t ∈ - {x ∈ S. s x = 0}"
apply eventually_elim
apply auto
using d_mvt
by fastforce
moreover
have "∀⇩F y in at x. returns_to ?P y"
by fact
then have "∀⇩F y in at x within {x. s x ≤ 0}. returns_to ?P y"
by (auto simp: eventually_at)
ultimately
have "∀⇩F y in at x within {x. s x ≤ 0}. return_time ?P y > ml"
apply eventually_elim
apply (rule return_time_gt)
by auto
}
then have "∀⇩F y in at x within {x. s x ≤ 0}. return_time ?P y ≥ return_time ?P x - e"
by eventually_elim (auto simp: ml_def)
ultimately
have "∀⇩F y in at x within {x . s x ≤ 0}. dist (return_time ?P y) (return_time ?P x) ≤ e"
unfolding eventually_at_filter
by eventually_elim (auto simp: dist_real_def abs_real_def algebra_simps)
then show "∀⇩F y in at x within {x. s x ≤ 0}. dist (return_time ?P y) (return_time ?P x) < e_orig"
by eventually_elim (use ‹e_orig > 0› in ‹auto simp: e_def›)
qed
lemma
return_time_continuous_below_plane:
fixes s::"'a::euclidean_space ⇒ real"
assumes rt: "returns_to {x ∈ R. x ∙ n = c} x" (is "returns_to ?P x")
assumes cR: "closed R"
assumes through: "f (poincare_map ?P x) ∙ n ≠ 0"
assumes R: "x ∈ R"
assumes inside: "x ∙ n = c" "f x ∙ n < 0"
assumes eventually_inside: "∀⇩F x in at (poincare_map ?P x). x ∙ n = c ⟶ x ∈ R"
shows "continuous (at x within {x. x ∙ n ≤ c}) (return_time ?P)"
apply (rule return_time_continuous_below[of R "λx. x ∙ n - c", simplified])
using through rt inside cR R eventually_inside
by (auto intro!: derivative_eq_intros blinfun_inner_left.rep_eq[symmetric])
lemma
poincare_map_in_interior_eventually_return_time_equal:
assumes RP: "R ⊆ P"
assumes cP: "closed P"
assumes cR: "closed R"
assumes ret: "returns_to P x"
assumes evret: "∀⇩F x in at x within S. returns_to P x"
assumes evR: "∀⇩F x in at x within S. poincare_map P x ∈ R"
shows "∀⇩F x in at x within S. returns_to R x ∧ return_time P x = return_time R x"
proof -
from evret evR
show ?thesis
proof eventually_elim
case (elim x)
from return_time_least[OF elim(1) cP] RP
have rtl: "⋀s. 0 < s ⟹ s < return_time P x ⟹ flow0 x s ∉ R"
by auto
from elim(2) have pR: "poincare_map P x ∈ R"
by auto
have "∀⇩F t in at_right 0. 0 < t"
by (simp add: eventually_at_filter)
moreover have "∀⇩F t in at_right 0. t < return_time P x"
using return_time_pos[OF elim(1) cP]
by (rule order_tendstoD[OF tendsto_ident_at])
ultimately have evR: "∀⇩F t in at_right 0. flow0 x t ∉ R"
proof eventually_elim
case et: (elim t)
from return_time_least[OF elim(1) cP et] show ?case using RP by auto
qed
have rtp: "0 < return_time P x" by (intro return_time_pos cP elim)
have rtex: "return_time P x ∈ existence_ivl0 x" by (intro return_time_exivl elim cP)
have frR: "flow0 x (return_time P x) ∈ R"
unfolding poincare_map_def[symmetric] by (rule pR)
have "returns_to R x"
by (rule returns_toI[where t="return_time P x"]; fact)
moreover have "return_time R x = return_time P x"
by (rule return_time_eqI) fact+
ultimately show ?case by auto
qed
qed
lemma poincare_map_in_planeI:
assumes "returns_to (plane n c) x0"
shows "poincare_map (plane n c) x0 ∙ n = c"
using poincare_map_returns[OF assms]
by fastforce
lemma less_return_time_imp_exivl:
"h ∈ existence_ivl0 x'" if "h ≤ return_time P x'" "returns_to P x'" "closed P" "0 ≤ h"
proof -
from return_time_exivl[OF that(2,3)]
have "return_time P x' ∈ existence_ivl0 x'" by auto
from ivl_subset_existence_ivl[OF this] that show ?thesis
by auto
qed
lemma eventually_returns_to_continuousI:
assumes "returns_to P x"
assumes "closed P"
assumes "continuous (at x within S) (return_time P)"
shows "∀⇩F x in at x within S. returns_to P x"
proof -
have "return_time P x > 0"
using assms by (auto simp: return_time_pos)
from order_tendstoD(1)[OF assms(3)[unfolded continuous_within] this]
have "∀⇩F x in at x within S. 0 < return_time P x" .
then show ?thesis
by eventually_elim (auto simp: return_time_pos_returns_to)
qed
lemma return_time_implicit_functionE:
fixes s::"'a::euclidean_space ⇒ real"
assumes rt: "returns_to {x ∈ S. s x = 0} x" (is "returns_to ?P _")
assumes cS: "closed S"
assumes Ds: "⋀x. (s has_derivative blinfun_apply (Ds x)) (at x)"
assumes DsC: "⋀x. isCont Ds x"
assumes Ds_through: "(Ds (poincare_map ?P x)) (f (poincare_map ?P x)) ≠ 0"
assumes eventually_inside: "∀⇩F x in at (poincare_map ?P x). s x = 0 ⟶ x ∈ S"
assumes outside: "x ∉ S ∨ s x ≠ 0"
obtains e' where
"0 < e'"
"⋀y. y ∈ ball x e' ⟹ returns_to ?P y"
"⋀y. y ∈ ball x e' ⟹ s (flow0 y (return_time ?P y)) = 0"
"continuous_on (ball x e') (return_time ?P)"
"(⋀y. y ∈ ball x e' ⟹ Ds (poincare_map ?P y) o⇩L flowderiv y (return_time ?P y) o⇩L embed2_blinfun ∈ invertibles_blinfun)"
"(⋀U v sa.
(⋀sa. sa ∈ U ⟹ s (flow0 sa (v sa)) = 0) ⟹
return_time ?P x = v x ⟹
continuous_on U v ⟹ sa ∈ U ⟹ x ∈ U ⟹ U ⊆ ball x e' ⟹ connected U ⟹ open U ⟹ return_time ?P sa = v sa)"
"(return_time ?P has_derivative
- blinfun_scaleR_left (inverse ((Ds (poincare_map ?P x)) (f (poincare_map ?P x)))) o⇩L
(Ds (poincare_map ?P x) o⇩L Dflow x (return_time ?P x)))
(at x)"
proof -
have cont_s: "continuous_on UNIV s" by (rule has_derivative_continuous_on[OF Ds])
then have s_tendsto: "(s ⤏ s x) (at x)" for x
by (auto simp: continuous_on_def)
have cls[simp, intro]: "closed {x ∈ S. s x = 0}"
by (rule closed_levelset_within) (auto intro!: cS continuous_on_subset[OF cont_s])
have cont_Ds: "continuous_on UNIV Ds"
using DsC by (auto simp: continuous_on_def isCont_def)
note [tendsto_intros] = continuous_on_tendsto_compose[OF cont_Ds _ UNIV_I, simplified]
note [continuous_intros] = continuous_on_compose2[OF cont_Ds _ subset_UNIV]
have "∀⇩F x in at (poincare_map ?P x). s x = 0 ⟶ x ∈ S"
using eventually_inside
by auto
then obtain U where "open U" "poincare_map ?P x ∈ U" "⋀x. x ∈ U ⟹ s x = 0 ⟹ x ∈ S"
using poincare_map_returns[OF rt cls]
by (force simp: eventually_at_topological)
have s_imp: "s (poincare_map ?P x) = 0 ⟶ poincare_map ?P x ∈ S"
using poincare_map_returns[OF rt cls]
by auto
have outside_disj: "x ∉ S ∨ s x ≠ 0 ∨ blinfun_apply (Ds x) (f x) ≠ 0"
using outside by auto
have pm_tendsto: "(poincare_map ?P ⤏ poincare_map ?P x) (at x)"
apply (rule poincare_map_tendsto)
unfolding isCont_def[symmetric]
apply (rule return_time_isCont_outside)
using assms
by (auto intro!: cls )
have evmemS: "∀⇩F x in at x. poincare_map ?P x ∈ S"
using eventually_returns_to[OF rt cS Ds DsC eventually_inside Ds_through outside_disj]
apply eventually_elim
using poincare_map_returns
by auto
have "∀⇩F x in at x. ∀⇩F x in at (poincare_map ?P x). s x = 0 ⟶ x ∈ S"
apply (rule eventually_tendsto_compose_within[OF _ _ pm_tendsto])
apply (rule eventually_eventually_withinI)
apply (rule eventually_inside)
apply (rule s_imp)
apply (rule eventually_inside)
apply (rule evmemS)
done
moreover
have "eventually (λx. x ∈ - ?P) (at x)"
apply (rule topological_tendstoD)
using outside
by (auto intro!: )
then have "eventually (λx. x ∉ S ∨ s x ≠ 0) (at x)"
by auto
moreover
have "eventually (λx. (Ds (poincare_map ?P x)) (f (poincare_map ?P x)) ≠ 0) (at x)"
apply (rule tendsto_imp_eventually_ne)
apply (rule tendsto_intros)
apply (rule tendsto_intros)
unfolding poincare_map_def
apply (rule tendsto_intros)
apply (rule tendsto_intros)
apply (subst isCont_def[symmetric])
apply (rule return_time_isCont_outside[OF rt cS Ds DsC Ds_through eventually_inside outside])
apply (rule return_time_exivl[OF rt cls])
apply (rule tendsto_intros)
apply (rule tendsto_intros)
apply (rule tendsto_intros)
apply (subst isCont_def[symmetric])
apply (rule return_time_isCont_outside[OF rt cS Ds DsC Ds_through eventually_inside outside])
apply (rule return_time_exivl[OF rt cls])
apply (rule flow_in_domain)
apply (rule return_time_exivl[OF rt cls])
unfolding poincare_map_def[symmetric]
apply (rule Ds_through)
done
ultimately
have "eventually (λy. returns_to ?P y ∧ (∀⇩F x in at (poincare_map ?P y). s x = 0 ⟶ x ∈ S) ∧
(y ∉ S ∨ s y ≠ 0) ∧ (Ds (poincare_map ?P y)) (f (poincare_map ?P y)) ≠ 0) (at x)"
using eventually_returns_to[OF rt cS Ds DsC eventually_inside Ds_through outside_disj]
by eventually_elim auto
then obtain Y' where Y': "open Y'" "x ∈ Y'" "⋀y. y ∈ Y' ⟹ returns_to ?P y"
"⋀y. y ∈ Y' ⟹ (∀⇩F x in at (poincare_map ?P y). s x = 0 ⟶ x ∈ S)"
"⋀y. y ∈ Y' ⟹ y ∉ S ∨ s y ≠ 0"
"⋀y. y ∈ Y' ⟹ blinfun_apply (Ds (poincare_map ?P y)) (f (poincare_map ?P y)) ≠ 0"
apply (subst (asm) (3) eventually_at_topological)
using rt outside Ds_through eventually_inside
by fastforce
from openE[OF ‹open Y'› ‹x ∈ Y'›] obtain eY where eY: "0 < eY" "ball x eY ⊆ Y'" by auto
define Y where "Y = ball x eY"
then have Y: "open Y" and x: "x ∈ Y"
and Yr: "⋀y. y ∈ Y ⟹ returns_to ?P y"
and Y_mem: "⋀y. y ∈ Y ⟹ (∀⇩F x in at (poincare_map ?P y). s x = 0 ⟶ x ∈ S)"
and Y_nz: "⋀y. y ∈ Y ⟹ y ∉ S ∨ s y ≠ 0"
and Y_fnz: "⋀y. y ∈ Y ⟹ Ds (poincare_map ?P y) (f (poincare_map ?P y)) ≠ 0"
and Y_convex: "convex Y"
using Y' eY
by (auto simp: subset_iff dist_commute)
have "isCont (return_time ?P) y" if "y ∈ Y" for y
using return_time_isCont_outside[OF Yr[OF that] cS Ds DsC Y_fnz Y_mem Y_nz, OF that that that] .
then have cY: "continuous_on Y (return_time ?P)"
by (auto simp: continuous_on_def isCont_def Lim_at_imp_Lim_at_within)
note [derivative_intros] = has_derivative_compose[OF _ Ds]
let ?t1 = "return_time ?P x"
have t1_exivl: "?t1 ∈ existence_ivl0 x"
by (auto intro!: return_time_exivl rt)
then have [simp]: "x ∈ X" by auto
have xt1: "(x, ?t1) ∈ Sigma Y existence_ivl0"
by (auto intro!: return_time_exivl rt x)
have "Sigma Y existence_ivl0 = Sigma X existence_ivl0 ∩ fst -` Y" by auto
also have "open …"
by (rule open_Int[OF open_state_space open_vimage_fst[OF ‹open Y›]])
finally have "open (Sigma Y existence_ivl0)" .
have D: "(⋀x. x ∈ Sigma Y existence_ivl0 ⟹
((λ(x, t). s (flow0 x t)) has_derivative
blinfun_apply (Ds (flow0 (fst x) (snd x)) o⇩L (flowderiv (fst x) (snd x))))
(at x))"
by (auto intro!: derivative_eq_intros)
have C: "continuous_on (Sigma Y existence_ivl0) (λx. Ds (flow0 (fst x) (snd x)) o⇩L flowderiv (fst x) (snd x))"
by (auto intro!: continuous_intros)
from return_time_returns[OF rt cls]
have Z: "(case (x, ?t1) of (x, t) ⇒ s (flow0 x t)) = 0"
by (auto simp: x)
have I1: "blinfun_scaleR_left (inverse (Ds (flow0 x (?t1))(f (flow0 x (?t1))))) o⇩L
((Ds (flow0 (fst (x, return_time ?P x))
(snd (x, return_time ?P x))) o⇩L
flowderiv (fst (x, return_time ?P x))
(snd (x, return_time ?P x))) o⇩L
embed2_blinfun)
= 1⇩L"
using Ds_through
by (auto intro!: blinfun_eqI
simp: rt flowderiv_def blinfun.bilinear_simps inverse_eq_divide poincare_map_def)
have I2: "((Ds (flow0 (fst (x, return_time ?P x))
(snd (x, return_time ?P x))) o⇩L
flowderiv (fst (x, return_time ?P x))
(snd (x, return_time ?P x))) o⇩L
embed2_blinfun) o⇩L blinfun_scaleR_left (inverse (Ds (flow0 x (?t1))(f (flow0 x (?t1)))))
= 1⇩L"
using Ds_through
by (auto intro!: blinfun_eqI
simp: rt flowderiv_def blinfun.bilinear_simps inverse_eq_divide poincare_map_def)
obtain u e where u:
"s (flow0 x (u x)) = 0"
"u x = return_time ?P x"
"(⋀sa. sa ∈ cball x e ⟹ s (flow0 sa (u sa)) = 0)"
"continuous_on (cball x e) u"
"(λt. (t, u t)) ` cball x e ⊆ Sigma Y existence_ivl0"
"0 < e"
"(u has_derivative
blinfun_apply
(- blinfun_scaleR_left
(inverse (blinfun_apply (Ds (poincare_map ?P x)) (f (poincare_map ?P x)))) o⇩L
(Ds (poincare_map ?P x) o⇩L flowderiv x (return_time ?P x)) o⇩L
embed1_blinfun))
(at x)"
"(⋀s. s ∈ cball x e ⟹
Ds (flow0 s (u s)) o⇩L flowderiv s (u s) o⇩L embed2_blinfun ∈ invertibles_blinfun)"
and unique: "(⋀U v sa.
(⋀sa. sa ∈ U ⟹ s (flow0 sa (v sa)) = 0) ⟹
u x = v x ⟹
continuous_on U v ⟹ sa ∈ U ⟹ x ∈ U ⟹ U ⊆ cball x e ⟹ connected U ⟹ open U ⟹ u sa = v sa)"
apply (rule implicit_function_theorem_unique[where f="λ(x, t). s (flow0 x t)"
and S="Sigma Y existence_ivl0", OF D xt1 ‹open (Sigma Y _)› order_refl C Z I1 I2])
apply blast
unfolding split_beta' fst_conv snd_conv poincare_map_def[symmetric]
apply (rule)
by (assumption+, blast)
have u_rt: "u y = return_time ?P y" if "y ∈ ball x e ∩ Y" for y
apply (rule unique[of "ball x e ∩ Y" "return_time ?P"])
subgoal for y
unfolding poincare_map_def[symmetric]
using poincare_map_returns[OF Yr cls]
by auto
subgoal by (auto simp: u)
subgoal using cY by (rule continuous_on_subset) auto
subgoal using that by auto
subgoal using x ‹0 < e› by auto
subgoal by auto
subgoal
apply (rule convex_connected)
apply (rule convex_Int)
apply simp
apply fact
done
subgoal by (auto intro!: open_Int ‹open Y›)
done
have *: "(- blinfun_scaleR_left
(inverse (blinfun_apply (Ds (poincare_map ?P x)) (f (poincare_map ?P x)))) o⇩L
(Ds (poincare_map ?P x) o⇩L flowderiv x (return_time ?P x)) o⇩L
embed1_blinfun) =
- blinfun_scaleR_left (inverse (blinfun_apply (Ds (poincare_map ?P x)) (f (poincare_map ?P x)))) o⇩L
(Ds (poincare_map ?P x) o⇩L Dflow x (return_time ?P x))"
by (auto intro!: blinfun_eqI simp: flowderiv_def)
define e' where "e' = min e eY"
have e'_eq: "ball x e' = ball x e ∩ Y" by (auto simp: e'_def Y_def)
have
"0 < e'"
"⋀y. y ∈ ball x e' ⟹ returns_to ?P y"
"⋀y. y ∈ ball x e' ⟹ s (flow0 y (return_time ?P y)) = 0"
"continuous_on (ball x e') (return_time ?P)"
"(⋀y. y ∈ ball x e' ⟹ Ds (poincare_map ?P y) o⇩L flowderiv y (return_time ?P y) o⇩L embed2_blinfun ∈ invertibles_blinfun)"
"(⋀U v sa.
(⋀sa. sa ∈ U ⟹ s (flow0 sa (v sa)) = 0) ⟹
return_time ?P x = v x ⟹
continuous_on U v ⟹ sa ∈ U ⟹ x ∈ U ⟹ U ⊆ ball x e' ⟹ connected U ⟹ open U ⟹ return_time ?P sa = v sa)"
"(return_time ?P has_derivative blinfun_apply
(- blinfun_scaleR_left
(inverse (blinfun_apply (Ds (poincare_map ?P x)) (f (poincare_map ?P x)))) o⇩L
(Ds (poincare_map ?P x) o⇩L flowderiv x (return_time ?P x)) o⇩L
embed1_blinfun))
(at x)"
unfolding e'_eq
subgoal by (auto simp: e'_def ‹0 < e› ‹0 < eY›)
subgoal by (rule Yr) auto
subgoal for y
unfolding poincare_map_def[symmetric]
using poincare_map_returns[OF Yr cls]
by auto
subgoal using cY by (rule continuous_on_subset) auto
subgoal premises prems for y
unfolding poincare_map_def
unfolding u_rt[OF prems, symmetric]
apply (rule u)
using prems by auto
subgoal premises prems for U v t
apply (subst u_rt[symmetric])
subgoal using prems by force
apply (rule unique[of U v])
subgoal by fact
subgoal by (auto simp: u prems)
subgoal by fact
subgoal by fact
subgoal by fact
subgoal using prems by auto
subgoal by fact
subgoal by fact
done
subgoal
proof -
have "∀⇩F x' in at x. x' ∈ ball x e'"
using eventually_at_ball[OF ‹0 < e'›]
by eventually_elim simp
then have "∀⇩F x' in at x. u x' = return_time ?P x'"
unfolding e'_eq
by eventually_elim (rule u_rt, auto)
from u(7) this
show ?thesis
by (rule has_derivative_transform_eventually) (auto simp: u)
qed
done
then show ?thesis unfolding * ..
qed
lemma return_time_has_derivative:
fixes s::"'a::euclidean_space ⇒ real"
assumes rt: "returns_to {x ∈ S. s x = 0} x" (is "returns_to ?P _")
assumes cS: "closed S"
assumes Ds: "⋀x. (s has_derivative blinfun_apply (Ds x)) (at x)"
assumes DsC: "⋀x. isCont Ds x"
assumes Ds_through: "(Ds (poincare_map ?P x)) (f (poincare_map ?P x)) ≠ 0"
assumes eventually_inside: "∀⇩F x in at (poincare_map {x ∈ S. s x = 0} x). s x = 0 ⟶ x ∈ S"
assumes outside: "x ∉ S ∨ s x ≠ 0"
shows "(return_time ?P has_derivative
- blinfun_scaleR_left (inverse ((Ds (poincare_map ?P x)) (f (poincare_map ?P x)))) o⇩L
(Ds (poincare_map ?P x) o⇩L Dflow x (return_time ?P x)))
(at x)"
using return_time_implicit_functionE[OF assms] by blast
lemma return_time_plane_has_derivative_blinfun:
assumes rt: "returns_to {x ∈ S. x ∙ i = c} x" (is "returns_to ?P _")
assumes cS: "closed S"
assumes fnz: "f (poincare_map ?P x) ∙ i ≠ 0"
assumes eventually_inside: "∀⇩F x in at (poincare_map ?P x). x ∙ i = c ⟶ x ∈ S"
assumes outside: "x ∉ S ∨ x ∙ i ≠ c"
shows "(return_time ?P has_derivative
(- blinfun_scaleR_left (inverse ((blinfun_inner_left i) (f (poincare_map ?P x)))) o⇩L
(blinfun_inner_left i o⇩L Dflow x (return_time ?P x)))) (at x)"
proof -
have rt: "returns_to {x ∈ S. x ∙ i - c = 0} x"
using rt by auto
have D: "((λx. x ∙ i - c) has_derivative blinfun_inner_left i) (at x)" for x
by (auto intro!: derivative_eq_intros)
have DC: "(⋀x. isCont (λx. blinfun_inner_left i) x)"
by (auto intro!: continuous_intros)
have nz: "blinfun_apply (blinfun_inner_left i) (f (poincare_map {x ∈ S. x ∙ i - c = 0} x)) ≠ 0"
using fnz by (auto )
from cS have cS: "closed S"by auto
have out: "x ∉ S ∨ x ∙ i - c ≠ 0" using outside by simp
from eventually_inside
have eventually_inside: "∀⇩F x in at (poincare_map {x ∈ S. x ∙ i - c = 0} x). x ∙ i - c = 0 ⟶ x ∈ S"
by auto
from return_time_has_derivative[OF rt cS D DC nz eventually_inside out]
show ?thesis
by auto
qed
lemma return_time_plane_has_derivative:
assumes rt: "returns_to {x ∈ S. x ∙ i = c} x" (is "returns_to ?P _")
assumes cS: "closed S"
assumes fnz: "f (poincare_map ?P x) ∙ i ≠ 0"
assumes eventually_inside: "∀⇩F x in at (poincare_map ?P x). x ∙ i = c ⟶ x ∈ S"
assumes outside: "x ∉ S ∨ x ∙ i ≠ c"
shows "(return_time ?P has_derivative
(λh. - (Dflow x (return_time ?P x)) h ∙ i / (f (poincare_map ?P x) ∙ i))) (at x)"
by (rule return_time_plane_has_derivative_blinfun[OF assms, THEN has_derivative_eq_rhs])
(auto simp: blinfun.bilinear_simps flowderiv_def inverse_eq_divide intro!: ext)
definition "Dpoincare_map i c S x =
(λh. (Dflow x (return_time {x ∈ S. x ∙ i = c} x)) h -
((Dflow x (return_time {x ∈ S. x ∙ i = c} x)) h ∙ i /
(f (poincare_map {x ∈ S. x ∙ i = c} x) ∙ i)) *⇩R f (poincare_map {x ∈ S. x ∙ i = c} x))"
definition "Dpoincare_map' i c S x =
Dflow x (return_time {x ∈ S. x ∙ i - c = 0} x) -
(blinfun_scaleR_left (f (poincare_map {x ∈ S. x ∙ i = c} x)) o⇩L
(blinfun_scaleR_left (inverse ((f (poincare_map {x ∈ S. x ∙ i = c} x) ∙ i))) o⇩L
(blinfun_inner_left i o⇩L Dflow x (return_time {x ∈ S. x ∙ i - c = 0} x))))"
theorem poincare_map_plane_has_derivative:
assumes rt: "returns_to {x ∈ S. x ∙ i = c} x" (is "returns_to ?P _")
assumes cS: "closed S"
assumes fnz: "f (poincare_map ?P x) ∙ i ≠ 0"
assumes eventually_inside: "∀⇩F x in at (poincare_map ?P x). x ∙ i = c ⟶ x ∈ S"
assumes outside: "x ∉ S ∨ x ∙ i ≠ c"
notes [derivative_intros] = return_time_plane_has_derivative[OF rt cS fnz eventually_inside outside]
shows "(poincare_map ?P has_derivative Dpoincare_map' i c S x) (at x)"
unfolding poincare_map_def Dpoincare_map'_def
using fnz outside
by (auto intro!: derivative_eq_intros return_time_exivl assms ext closed_levelset_within
continuous_intros
simp: flowderiv_eq poincare_map_def blinfun.bilinear_simps inverse_eq_divide algebra_simps)
end
end
Theory Reachability_Analysis
theory Reachability_Analysis
imports
Flow
Poincare_Map
begin
lemma not_mem_eq_mem_not: "a ∉ A ⟷ a ∈ - A"
by auto
lemma continuous_orderD:
fixes g::"'b::t2_space ⇒ 'c::order_topology"
assumes "continuous (at x within S) g"
shows "g x > c ⟹ ∀⇩F y in at x within S. g y > c"
"g x < c ⟹ ∀⇩F y in at x within S. g y < c"
using order_tendstoD[OF assms[unfolded continuous_within]]
by auto
lemma frontier_halfspace_component_ge: "n ≠ 0 ⟹ frontier {x. c ≤ x ∙ n} = plane n c"
apply (subst (1) inner_commute)
apply (subst (2) inner_commute)
apply (subst frontier_halfspace_ge[of n c])
by auto
lemma closed_Collect_le_within:
fixes f g :: "'a :: topological_space ⇒ 'b::linorder_topology"
assumes f: "continuous_on UNIV f"
and g: "continuous_on UNIV g"
and "closed R"
shows "closed {x ∈ R. f x ≤ g x}"
proof -
have *: "- R ∪ {x. g x < f x} = - {x ∈ R. f x ≤ g x}"
by auto
have "open (-R)" using assms by auto
from open_Un[OF this open_Collect_less [OF g f], unfolded *]
show ?thesis
by (simp add: closed_open)
qed
subsection ‹explicit representation of hyperplanes / halfspaces›
datatype 'a sctn = Sctn (normal: 'a) (pstn: real)
definition "le_halfspace sctn x ⟷ x ∙ normal sctn ≤ pstn sctn"
definition "lt_halfspace sctn x ⟷ x ∙ normal sctn < pstn sctn"
definition "ge_halfspace sctn x ⟷ x ∙ normal sctn ≥ pstn sctn"
definition "gt_halfspace sctn x ⟷ x ∙ normal sctn > pstn sctn"
definition "plane_of sctn = {x. x ∙ normal sctn = pstn sctn}"
definition "above_halfspace sctn = Collect (ge_halfspace sctn)"
definition "below_halfspace sctn = Collect (le_halfspace sctn)"
definition "sbelow_halfspace sctn = Collect (lt_halfspace sctn)"
definition "sabove_halfspace sctn = Collect (gt_halfspace sctn)"
subsection ‹explicit H representation of polytopes (mind ‹Polytopes.thy›)›
definition below_halfspaces
where "below_halfspaces sctns = ⋂(below_halfspace ` sctns)"
definition sbelow_halfspaces
where "sbelow_halfspaces sctns = ⋂(sbelow_halfspace ` sctns)"
definition above_halfspaces
where "above_halfspaces sctns = ⋂(above_halfspace ` sctns)"
definition sabove_halfspaces
where "sabove_halfspaces sctns = ⋂(sabove_halfspace ` sctns)"
lemmas halfspace_simps =
above_halfspace_def
sabove_halfspace_def
below_halfspace_def
sbelow_halfspace_def
below_halfspaces_def
sbelow_halfspaces_def
above_halfspaces_def
sabove_halfspaces_def
ge_halfspace_def[abs_def]
gt_halfspace_def[abs_def]
le_halfspace_def[abs_def]
lt_halfspace_def[abs_def]
subsection ‹predicates for reachability analysis›
context c1_on_open_euclidean
begin
definition flowpipe ::
"(('a::euclidean_space) × ('a ⇒⇩L 'a)) set ⇒ real ⇒ real ⇒
('a × ('a ⇒⇩L 'a)) set ⇒ ('a × ('a ⇒⇩L 'a)) set ⇒ bool"
where "flowpipe X0 hl hu CX X1 ⟷ 0 ≤ hl ∧ hl ≤ hu ∧ fst ` X0 ⊆ X ∧ fst ` CX ⊆ X ∧ fst ` X1 ⊆ X ∧
(∀(x0, d0) ∈ X0. ∀h ∈ {hl .. hu}.
h ∈ existence_ivl0 x0 ∧ (flow0 x0 h, Dflow x0 h o⇩L d0) ∈ X1 ∧ (∀h' ∈ {0 .. h}. (flow0 x0 h', Dflow x0 h' o⇩L d0) ∈ CX))"
lemma flowpipeD:
assumes "flowpipe X0 hl hu CX X1"
shows flowpipe_safeD: "fst ` X0 ∪ fst ` CX ∪ fst ` X1 ⊆ X"
and flowpipe_nonneg: "0 ≤ hl" "hl ≤ hu"
and flowpipe_exivl: "hl ≤ h ⟹ h ≤ hu ⟹ (x0, d0) ∈ X0 ⟹ h ∈ existence_ivl0 x0"
and flowpipe_discrete: "hl ≤ h ⟹ h ≤ hu ⟹ (x0, d0) ∈ X0 ⟹ (flow0 x0 h, Dflow x0 h o⇩L d0) ∈ X1"
and flowpipe_cont: "hl ≤ h ⟹ h ≤ hu ⟹ (x0, d0) ∈ X0 ⟹ 0 ≤ h' ⟹ h' ≤ h ⟹ (flow0 x0 h', Dflow x0 h' o⇩L d0) ∈ CX"
using assms
by (auto simp: flowpipe_def)
lemma flowpipe_source_subset: "flowpipe X0 hl hu CX X1 ⟹ X0 ⊆ CX"
apply (auto dest: bspec[where x=hl] bspec[where x=0] simp: flowpipe_def)
apply (drule bspec)
apply (assumption)
apply auto
apply (drule bspec[where x=hl])
apply auto
apply (drule bspec[where x=0])
by (auto simp: flow_initial_time_if)
definition "flowsto X0 T CX X1 ⟷
(∀(x0, d0) ∈ X0. ∃h ∈ T. h ∈ existence_ivl0 x0 ∧ (flow0 x0 h, Dflow x0 h o⇩L d0) ∈ X1 ∧ (∀h' ∈ open_segment 0 h. (flow0 x0 h', Dflow x0 h' o⇩L d0) ∈ CX))"
lemma flowsto_to_empty_iff[simp]: "flowsto a t b {} ⟷ a = {}"
by (auto simp: simp: flowsto_def)
lemma flowsto_from_empty_iff[simp]: "flowsto {} t b c"
by (auto simp: simp: flowsto_def)
lemma flowsto_empty_time_iff[simp]: "flowsto a {} b c ⟷ a = {}"
by (auto simp: simp: flowsto_def)
lemma flowstoE:
assumes "flowsto X0 T CX X1" "(x0, d0) ∈ X0"
obtains h where "h ∈ T" "h ∈ existence_ivl0 x0" "(flow0 x0 h, Dflow x0 h o⇩L d0) ∈ X1"
"⋀h'. h' ∈ open_segment 0 h ⟹ (flow0 x0 h', Dflow x0 h' o⇩L d0) ∈ CX"
using assms
by (auto simp: flowsto_def)
lemma flowsto_safeD: "flowsto X0 T CX X1 ⟹ fst ` X0 ⊆ X"
by (auto simp: flowsto_def split_beta' mem_existence_ivl_iv_defined)
lemma flowsto_union:
assumes 1: "flowsto X0 T CX Y" and 2: "flowsto Z S CZ W"
shows "flowsto (X0 ∪ Z) (T ∪ S) (CX ∪ CZ) (Y ∪ W)"
using assms unfolding flowsto_def
by force
lemma flowsto_subset:
assumes "flowsto X0 T CX Y"
assumes "Z ⊆ X0" "T ⊆ S" "CX ⊆ CZ" "Y ⊆ W"
shows "flowsto Z S CZ W"
unfolding flowsto_def
using assms
by (auto elim!: flowstoE) blast
lemmas flowsto_unionI = flowsto_subset[OF flowsto_union]
lemma flowsto_unionE:
assumes "flowsto X0 T CX (Y ∪ Z)"
obtains X1 X2 where "X0 = X1 ∪ X2" "flowsto X1 T CX Y" "flowsto X2 T CX Z"
proof -
let ?X1 = "{x∈X0. flowsto {x} T CX Y}"
let ?X2 = "{x∈X0. flowsto {x} T CX Z}"
from assms have "X0 = ?X1 ∪ ?X2" "flowsto ?X1 T CX Y" "flowsto ?X2 T CX Z"
by (auto simp: flowsto_def)
thus ?thesis ..
qed
lemma flowsto_trans:
assumes A: "flowsto A S B C" and C: "flowsto C T D E"
shows "flowsto A {s + t |s t. s ∈ S ∧ t ∈ T} (B ∪ D ∪ C) E"
unfolding flowsto_def
proof safe
fix x0 d0 assume x0: "(x0, d0) ∈ A"
from flowstoE[OF A x0]
obtain h where h: "h ∈ S" "h ∈ existence_ivl0 x0" "(flow0 x0 h, (Dflow x0 h) o⇩L d0) ∈ C"
"⋀h'. h' ∈ {0<--<h} ⟹ (flow0 x0 h', Dflow x0 h' o⇩L d0) ∈ B"
by auto
from h(2) have x0[simp]: "x0 ∈ X" by auto
from flowstoE[OF C ‹_ ∈ C›]
obtain i where i: "i ∈ T" "i ∈ existence_ivl0 (flow0 x0 h)"
"(flow0 (flow0 x0 h) i, Dflow (flow0 x0 h) i o⇩L Dflow x0 h o⇩L d0) ∈ E"
"⋀h'. h' ∈ {0<--<i} ⟹ (flow0 (flow0 x0 h) h', Dflow (flow0 x0 h) h' o⇩L (Dflow x0 h o⇩L d0)) ∈ D"
by (auto simp: ac_simps)
have hi: "h + i ∈ existence_ivl0 x0"
using ‹h ∈ existence_ivl0 x0› ‹i ∈ existence_ivl0 (flow0 x0 h)› existence_ivl_trans by blast
moreover have "(flow0 x0 (h + i), Dflow x0 (h + i) o⇩L d0) ∈ E"
apply (subst flow_trans)
apply fact apply fact
apply (subst Dflow_trans)
apply fact apply fact
apply fact
done
moreover have "(flow0 x0 h', Dflow x0 h' o⇩L d0) ∈ B ∪ D ∪ C" if "h'∈{0<--<h + i}" for h'
proof cases
assume "h' ∈ {0 <--< h}"
then show ?thesis using h by simp
next
assume "h' ∉ {0 <--< h}"
with that have h': "h' - h ∈ {0 <--< i}" if "h' ≠ h"
using that
by (auto simp: open_segment_eq_real_ivl closed_segment_eq_real_ivl split: if_splits)
from i(4)[OF this]
show ?thesis
apply (cases "h' = h")
subgoal using h by force
subgoal
apply simp
apply (subst (asm) flow_trans[symmetric])
subgoal by (rule h)
subgoal using ‹_ ⟹ h' - h ∈ {0<--<i}› i(2) local.in_existence_between_zeroI
apply auto
using open_closed_segment by blast
subgoal
unfolding blinfun_compose_assoc[symmetric]
apply (subst (asm) Dflow_trans[symmetric])
apply auto
apply fact+
done
done
done
qed
ultimately show "∃h∈{s + t |s t. s ∈ S ∧ t ∈ T}.
h ∈ existence_ivl0 x0 ∧ (flow0 x0 h, Dflow x0 h o⇩L d0) ∈ E ∧ (∀h'∈{0<--<h}. (flow0 x0 h', Dflow x0 h' o⇩L d0) ∈ B ∪ D ∪ C)"
using ‹h ∈ S› ‹i ∈ T›
by (auto intro!: bexI[where x="h + i"])
qed
lemma flowsto_step:
assumes A: "flowsto A S B C"
assumes D: "flowsto D T E F"
shows "flowsto A (S ∪ {s + t |s t. s ∈ S ∧ t ∈ T}) (B ∪ E ∪ C ∩ D) (C - D ∪ F)"
proof -
have "C = (C ∩ D) ∪ (C - D)" (is "_ = ?C1 ∪ ?C2")
by auto
then have "flowsto A S B (?C1 ∪ ?C2)" using A by simp
from flowsto_unionE[OF this]
obtain A1 A2 where "A = A1 ∪ A2" and A1: "flowsto A1 S B ?C1" and A2: "flowsto A2 S B ?C2"
by auto
have "flowsto ?C1 T E F"
using D by (rule flowsto_subset) auto
from flowsto_union[OF flowsto_trans[OF A1 this] A2]
show ?thesis by (auto simp add: ‹A = _› ac_simps)
qed
lemma
flowsto_stepI:
"flowsto X0 U B C ⟹
flowsto D T E F ⟹
Z ⊆ X0 ⟹
(⋀s. s ∈ U ⟹ s ∈ S) ⟹
(⋀s t. s ∈ U ⟹ t ∈ T ⟹ s + t ∈ S) ⟹
B ∪ E ∪ D ∩ C ⊆ CZ ⟹ C - D ∪ F ⊆ W ⟹ flowsto Z S CZ W"
by (rule flowsto_subset[OF flowsto_step]) auto
lemma flowsto_imp_flowsto:
"flowpipe Y h h CY Z ⟹ flowsto Y {h} (CY) Z"
unfolding flowpipe_def flowsto_def
by (auto simp: open_segment_eq_real_ivl split_beta')
lemma connected_below_halfspace:
assumes "x ∈ below_halfspace sctn"
assumes "x ∈ S" "connected S"
assumes "S ∩ plane_of sctn = {}"
shows "S ⊆ below_halfspace sctn"
proof -
note ‹connected S›
moreover
have "open {x. x ∙ normal sctn < pstn sctn}" (is "open ?X")
and "open {x. x ∙ normal sctn > pstn sctn}" (is "open ?Y")
by (auto intro!: open_Collect_less continuous_intros)
moreover have "?X ∩ ?Y ∩ S = {}" "S ⊆ ?X ∪ ?Y"
using assms by (auto simp: plane_of_def)
ultimately have "?X ∩ S = {} ∨ ?Y ∩ S = {}"
by (rule connectedD)
then show ?thesis
using assms
by (force simp: below_halfspace_def le_halfspace_def plane_of_def)
qed
lemma
inter_Collect_eq_empty:
assumes "⋀x. x ∈ X0 ⟹ ¬ g x" shows "X0 ∩ Collect g = {}"
using assms by auto
subsection ‹Poincare Map›
lemma closed_plane_of[simp]: "closed (plane_of sctn)"
by (auto simp: plane_of_def intro!: closed_Collect_eq continuous_intros)
definition "poincare_mapsto P X0 S CX Y ⟷ (∀(x, d) ∈ X0.
returns_to P x ∧ fst ` X0 ⊆ S ∧
(return_time P differentiable at x within S) ∧
(∃D. (poincare_map P has_derivative blinfun_apply D) (at x within S) ∧
(poincare_map P x, D o⇩L d) ∈ Y) ∧
(∀t∈{0<..<return_time P x}. flow0 x t ∈ CX))"
lemma poincare_mapsto_empty[simp]:
"poincare_mapsto P {} S CX Y"
by (auto simp: poincare_mapsto_def)
lemma flowsto_eventually_mem_cont:
assumes "flowsto X0 T CX Y" "(x, d) ∈ X0" "T ⊆ {0<..}"
shows "∀⇩F t in at_right 0. (flow0 x t, Dflow x t o⇩L d) ∈ CX"
proof -
from flowstoE[OF assms(1,2)] assms(3)
obtain h where h: "0 < h" "h ∈ T" "h ∈ existence_ivl0 x" "(flow0 x h, (Dflow x h) o⇩L d) ∈ Y" "⋀h'. h' ∈ {0<--<h} ⟹ (flow0 x h', (Dflow x h') o⇩L d) ∈ CX"
by (auto simp: subset_iff)
have "∀⇩F x in at_right 0. 0 < x ∧ x < h"
apply (rule eventually_conj[OF eventually_at_right_less])
using eventually_at_right h(1) by blast
then show ?thesis
by eventually_elim (auto intro!: h simp: open_segment_eq_real_ivl)
qed
lemma frontier_aux_lemma:
fixes R :: "'n::euclidean_space set"
assumes "closed R" "R ⊆ {x. x ∙ n = c}" and [simp]: "n ≠ 0"
shows "frontier {x ∈ R. c ≤ x ∙ n} = {x ∈ R. c = x ∙ n}"
apply (auto simp: frontier_closures)
subgoal by (metis (full_types) Collect_subset assms(1) closure_minimal subsetD)
subgoal premises prems for x
proof -
note prems
have "closed {x ∈ R. c ≤ x ∙ n}"
by (auto intro!: closed_Collect_le_within continuous_intros assms)
from closure_closed[OF this] prems(1)
have "x ∈ R" "c ≤ x ∙ n" by auto
with assms show ?thesis by auto
qed
subgoal for x
using closure_subset by fastforce
subgoal premises prems for x
proof -
note prems
have *: "{xa ∈ R. x ∙ n ≤ xa ∙ n} = R"
using assms prems by auto
have "interior R ⊆ interior (plane n c)"
by (rule interior_mono) (use assms in auto)
also have "… = {}"
by (subst inner_commute) simp
finally have R: "interior R = {}" by simp
have "x ∈ closure (- R)"
unfolding closure_complement
by (auto simp: R)
then show ?thesis
unfolding * by simp
qed
done
lemma blinfun_minus_comp_distrib: "(a - b) o⇩L c = (a o⇩L c) - (b o⇩L c)"
by (auto intro!: blinfun_eqI simp: blinfun.bilinear_simps)
lemma flowpipe_split_at_above_halfspace:
assumes "flowpipe X0 hl t CX Y" "fst ` X0 ∩ {x. x ∙ n ≥ c} = {}" and [simp]: "n ≠ 0"
assumes cR: "closed R" and Rs: "R ⊆ plane n c"
assumes PDP: "⋀x d. (x, d) ∈ CX ⟹ x ∙ n = c ⟹ (x,
d - (blinfun_scaleR_left (f (x)) o⇩L (blinfun_scaleR_left (inverse (f x ∙ n)) o⇩L (blinfun_inner_left n o⇩L d)))) ∈ PDP"
assumes PDP_nz: "⋀x d. (x, d) ∈ PDP ⟹ f x ∙ n ≠ 0"
assumes PDP_inR: "⋀x d. (x, d) ∈ PDP ⟹ x ∈ R"
assumes PDP_in: "⋀x d. (x, d) ∈ PDP ⟹ ∀⇩F x in at x within plane n c. x ∈ R"
obtains X1 X2 where "X0 = X1 ∪ X2"
"flowsto X1 {0<..t} (CX ∩ {x. x ∙ n < c} × UNIV) (CX ∩ {x ∈ R. x ∙ n = c} × UNIV)"
"flowsto X2 {hl .. t} (CX ∩ {x. x ∙ n < c} × UNIV) (Y ∩ ({x. x ∙ n < c} × UNIV))"
"poincare_mapsto {x ∈ R. x ∙ n = c} X1 UNIV (fst ` CX ∩ {x. x ∙ n < c}) PDP"
proof -
let ?sB = "{x. x ∙ n < c}"
let ?A = "{x. x ∙ n ≥ c}"
let ?P = "{x ∈ R. x ∙ n = c}"
have [intro]: "closed ?A" "closed ?P"
by (auto intro!: closed_Collect_le_within closed_levelset_within continuous_intros cR
closed_halfspace_component_ge)
let ?CX = "CX ∩ ?sB × UNIV"
let ?X1 = "{x∈X0. flowsto {x} {0 <.. t} ?CX (CX ∩ (?P × UNIV))}"
let ?X2 = "{x∈X0. flowsto {x} {hl .. t} ?CX (Y ∩ (?sB × UNIV))}"
have "(x, d) ∈ ?X1 ∨ (x, d) ∈ ?X2" if "(x, d) ∈ X0" for x d
proof -
from that assms have
t: "t ∈ existence_ivl0 x" "⋀s. 0 ≤ s ⟹ s ≤ t ⟹ (flow0 x s, Dflow x s o⇩L d) ∈ CX" "(flow0 x t, Dflow x t o⇩L d) ∈ Y"
apply (auto simp: flowpipe_def dest!: bspec[where x=t])
apply (drule bspec[where x="(x, d)"], assumption)
apply simp
apply (drule bspec[where x=t], force)
apply auto
done
show ?thesis
proof (cases "∀s∈{0..t}. flow0 x s ∈ ?sB")
case True
then have "(x, d) ∈ ?X2" using assms t ‹(x, d) ∈ X0›
by (auto simp: flowpipe_def flowsto_def open_segment_eq_real_ivl dest!: bspec[where x="(x, d)"])
then show ?thesis ..
next
case False
then obtain s where s: "0 ≤ s" "s ≤ t" "flow0 x s ∈ ?A"
by (auto simp: not_less)
let ?I = "flow0 x -` ?A ∩ {0 .. s}"
from s have exivlI: "0 ≤ s' ⟹ s' ≤ s ⟹ s' ∈ existence_ivl0 x" for s'
using ivl_subset_existence_ivl[OF ‹t ∈ existence_ivl0 x›]
by auto
then have "compact ?I"
unfolding compact_eq_bounded_closed
by (intro conjI bounded_Int bounded_closed_interval disjI2 closed_vimage_Int)
(auto intro!: continuous_intros closed_Collect_le_within cR)
moreover
from s have "?I ≠ {}" by auto
ultimately have "∃s∈?I. ∀t∈?I. s ≤ t"
by (rule compact_attains_inf)
then obtain s' where s': "⋀s''. 0 ≤ s'' ⟹ s'' < s' ⟹ flow0 x s'' ∉ ?A"
"flow0 x s' ∈ ?A" "0 ≤ s'" "s' ≤ s"
by (force simp: Ball_def)
have "flow0 x 0 = x" using local.mem_existence_ivl_iv_defined(2) t(1) by auto
also have "… ∉ ?A" using assms ‹(x, d) ∈ X0› by auto
finally have "s' ≠ 0" using s' by auto
then have "0 < s'" using ‹s' ≥ 0› by simp
have False if "flow0 x s' ∈ interior ?A"
proof -
from that obtain e where "e > 0" and subset: "ball (flow0 x s') e ⊆ ?A"
by (auto simp: mem_interior)
from subset have "∀⇩F s'' in at_left s'. ball (flow0 x s') e ⊆ ?A" by simp
moreover
from flow_continuous[OF exivlI[OF ‹0 ≤ s'› ‹s' ≤ s›]]
have "flow0 x ─s'→ flow0 x s'" unfolding isCont_def .
from tendstoD[OF this ‹0 < e›]
have "∀⇩F xa in at_left s'. dist (flow0 x xa) (flow0 x s') < e"
using eventually_at_split by blast
then have "∀⇩F s'' in at_left s'. flow0 x s'' ∈ ball (flow0 x s') e"
by (simp add: dist_commute)
moreover
have "∀⇩F s'' in at_left s'. 0 < s''"
using ‹0 < s'›
using eventually_at_left by blast
moreover
have "∀⇩F s'' in at_left s'. s'' < s'"
by (auto simp: eventually_at_filter)
ultimately
have "∀⇩F s'' in at_left s'. False"
by eventually_elim (use s' in auto)
then show False
by auto
qed
then have "flow0 x s' ∈ frontier ?A"
unfolding frontier_def
using ‹closed ?A› s'
by auto
with s' have "(x, d) ∈ ?X1" using assms that s t ‹0 < s'›
ivl_subset_existence_ivl[OF ‹t ∈ existence_ivl0 x›]
frontier_subset_closed[OF ‹closed ?A›]
apply (auto simp: flowsto_def flowpipe_def open_segment_eq_real_ivl frontier_halfspace_component_ge
intro!:
dest!: bspec[where x="(x, d)"]
intro: exivlI)
apply (safe intro!: bexI[where x=s'])
subgoal by force
subgoal premises prems
proof -
have CX: "(flow0 x s', Dflow x s' o⇩L d) ∈ CX"
using prems
by (auto intro!: prems)
have "flow0 x s' ∙ n = c" using prems by auto
from PDP_inR[OF PDP[OF CX this]]
show "flow0 x s' ∈ R" .
qed
subgoal by (auto simp: not_le)
subgoal by force
done
then show ?thesis ..
qed
qed
then have "X0 = ?X1 ∪ ?X2" by auto
moreover
have X1: "flowsto ?X1 {0 <.. t} ?CX (CX ∩ (?P × UNIV))"
and X2: "flowsto ?X2 {hl .. t} ?CX (Y ∩ (?sB × UNIV))"
by (auto simp: flowsto_def flowpipe_def)
moreover
from assms(2) X1 have "poincare_mapsto ?P ?X1 UNIV (fst ` CX ∩ {x. x ∙ n < c}) PDP"
unfolding poincare_mapsto_def flowsto_def
apply clarsimp
subgoal premises prems for x d t
proof -
note prems
have ret: "returns_to ?P x"
apply (rule returns_to_outsideI[where t=t])
using prems ‹closed ?P›
by auto
moreover
have ret_le: "return_time ?P x ≤ t"
apply (rule return_time_le[OF ret _ _ ‹0 < t›])
using prems ‹closed ?P› by auto
from prems have CX: "(flow0 x h', (Dflow x h') o⇩L d) ∈ CX" if "0 < h'" "h' ≤ t" for h'
using that by (auto simp: open_segment_eq_real_ivl)
have PDP: "(poincare_map ?P x, Dpoincare_map' n c R x o⇩L d) ∈ PDP"
unfolding poincare_map_def Dpoincare_map'_def
unfolding blinfun_compose_assoc blinfun_minus_comp_distrib
apply (rule PDP)
using poincare_map_returns[OF ret ‹closed ?P›] ret_le
by (auto simp: poincare_map_def intro!: CX return_time_pos ret)
have "eventually (returns_to ({x ∈ R. x ∙ n - c = 0})) (at x)"
apply (rule eventually_returns_to)
using PDP_nz[OF PDP] assms(2) ‹(x, d) ∈ X0› cR PDP_in[OF PDP]
by (auto intro!: ret derivative_eq_intros blinfun_inner_left.rep_eq[symmetric]
simp: eventually_at_filter)
moreover have "return_time ?P differentiable at x"
apply (rule differentiableI)
apply (rule return_time_plane_has_derivative)
using prems ret PDP_nz[OF PDP] PDP cR PDP_in[OF PDP]
by (auto simp: eventually_at_filter)
moreover
have "(∃D. (poincare_map ?P has_derivative blinfun_apply D) (at x) ∧ (poincare_map ?P x, D o⇩L d) ∈ PDP)"
apply (intro exI[where x="Dpoincare_map' n c R x"])
using prems ret PDP_nz[OF PDP] PDP cR PDP_in[OF PDP]
by (auto simp: eventually_at_filter intro!: poincare_map_plane_has_derivative)
moreover have
"flow0 x h ∈ fst ` CX ∧ (c > flow0 x h ∙ n)"
if "0 < h" "h < return_time ?P x" for h
using CX[of h] ret that ret_le ‹0 < h›
apply (auto simp: open_segment_eq_real_ivl intro!: image_eqI[where x="(flow0 x h, (Dflow x h) o⇩L d)"])
using prems
by (auto simp add: open_segment_eq_real_ivl dest!: bspec[where x=t])
ultimately show ?thesis
unfolding prems(7)[symmetric]
by force
qed
done
ultimately show ?thesis ..
qed
lemma poincare_map_has_derivative_step:
assumes Deriv: "(poincare_map P has_derivative blinfun_apply D) (at (flow0 x0 h))"
assumes ret: "returns_to P x0"
assumes cont: "continuous (at x0 within S) (return_time P)"
assumes less: "0 ≤ h" "h < return_time P x0"
assumes cP: "closed P" and x0: "x0 ∈ S"
shows "((λx. poincare_map P x) has_derivative (D o⇩L Dflow x0 h)) (at x0 within S)"
proof (rule has_derivative_transform_eventually)
note return_time_tendsto = cont[unfolded continuous_within, rule_format]
have "return_time P x0 ∈ existence_ivl0 x0"
by (auto intro!: return_time_exivl cP ret)
from ivl_subset_existence_ivl[OF this] less
have hex: "h ∈ existence_ivl0 x0" by auto
from eventually_mem_existence_ivl[OF this]
have "∀⇩F x in at x0 within S. h ∈ existence_ivl0 x"
by (auto simp: eventually_at)
moreover
have "∀⇩F x in at x0 within S. h < return_time P x"
apply (rule order_tendstoD)
apply (rule return_time_tendsto)
by (auto intro!: x0 less)
moreover have evret: "eventually (returns_to P) (at x0 within S)"
by (rule eventually_returns_to_continuousI; fact)
ultimately
show "∀⇩F x in at x0 within S. poincare_map P (flow0 x h) = poincare_map P x"
apply eventually_elim
apply (cases "h = 0")
subgoal by auto
subgoal for x
apply (rule poincare_map_step_flow)
using ‹0 ≤ h› return_time_least[of P x ]
by (auto simp: ‹closed P›)
done
show "poincare_map P (flow0 x0 h) = poincare_map P x0"
using less ret x0 cP hex
apply (cases "h = 0")
subgoal by auto
subgoal
apply (rule poincare_map_step_flow)
using ‹0 ≤ h› return_time_least[of P x0] ret
by (auto simp: ‹closed P›)
done
show "x0 ∈ S" by fact
show "((λx. poincare_map P (flow0 x h)) has_derivative blinfun_apply (D o⇩L Dflow x0 h)) (at x0 within S)"
apply (rule has_derivative_compose[where g="poincare_map P" and f="λx. flow0 x h", OF _ Deriv,
THEN has_derivative_eq_rhs])
by (auto intro!: derivative_eq_intros simp: hex flowderiv_def)
qed
lemma poincare_mapsto_trans:
assumes "poincare_mapsto p1 X0 S CX P1"
assumes "poincare_mapsto p2 P1 UNIV CY P2"
assumes "CX ∪ CY ∪ fst ` P1 ⊆ CZ"
assumes "p2 ∩ (CX ∪ fst ` P1) = {}"
assumes [intro, simp]: "closed p1"
assumes [intro, simp]: "closed p2"
assumes cont: "⋀x d. (x, d) ∈ X0 ⟹ continuous (at x within S) (return_time p2)"
shows "poincare_mapsto p2 X0 S CZ P2"
unfolding poincare_mapsto_def
proof (auto, goal_cases)
fix x0 d0 assume x0: "(x0, d0) ∈ X0"
from assms(1) x0 obtain D1 dR1 where 1:
"returns_to p1 x0"
"fst ` X0 ⊆ S"
"(return_time p1 has_derivative dR1) (at x0 within S)"
"(poincare_map p1 has_derivative blinfun_apply D1) (at x0 within S)"
"(poincare_map p1 x0, D1 o⇩L d0) ∈ P1"
"⋀t. 0 < t ⟹ t < return_time p1 x0 ⟹ flow0 x0 t ∈ CX"
by (auto simp: poincare_mapsto_def differentiable_def)
then have crt1: "continuous (at x0 within S) (return_time p1)"
by (auto intro!: has_derivative_continuous)
show "x0 ∈ S"
using 1 x0 by auto
let ?x0 = "poincare_map p1 x0"
from assms(2) x0 ‹_ ∈ P1›
obtain D2 dR2 where 2:
"returns_to p2 ?x0"
"(return_time p2 has_derivative dR2) (at ?x0)"
"(poincare_map p2 has_derivative blinfun_apply D2) (at ?x0)"
"(poincare_map p2 ?x0, D2 o⇩L (D1 o⇩L d0)) ∈ P2"
"⋀t. t∈{0<..<return_time p2 ?x0} ⟹ flow0 ?x0 t ∈ CY"
by (auto simp: poincare_mapsto_def differentiable_def)
have "∀⇩F t in at_right 0. t < return_time p1 x0"
by (rule order_tendstoD) (auto intro!: return_time_pos 1)
moreover have "∀⇩F t in at_right 0. 0 < t"
by (auto simp: eventually_at_filter)
ultimately have evnotp2: "∀⇩F t in at_right 0. flow0 x0 t ∉ p2"
by eventually_elim (use assms 1 in auto)
from 2(1)
show ret2: "returns_to p2 x0"
unfolding poincare_map_def
by (rule returns_to_earlierI)
(use evnotp2 in ‹auto intro!: less_imp_le return_time_pos 1 return_time_exivl›)
have not_p2: "0 < t ⟹ t ≤ return_time p1 x0 ⟹ flow0 x0 t ∉ p2" for t
using 1(5) 1(6)[of t] assms(4)
by (force simp: poincare_map_def set_eq_iff)
have pm_eq: "poincare_map p2 x0 = poincare_map p2 (poincare_map p1 x0)"
using not_p2
apply (auto simp: poincare_map_def)
apply (subst flow_trans[symmetric])
apply (auto intro!: return_time_exivl 1 2[unfolded poincare_map_def])
apply (subst return_time_step)
by (auto simp: return_time_step
intro!: return_time_exivl 1 2[unfolded poincare_map_def] return_time_pos)
have evret2: "∀⇩F x in at ?x0. returns_to p2 x"
by (auto intro!: eventually_returns_to_continuousI 2 has_derivative_continuous)
have evret1: "∀⇩F x in at x0 within S. returns_to p1 x"
by (auto intro!: eventually_returns_to_continuousI 1 has_derivative_continuous)
moreover
from evret2[unfolded eventually_at_topological] 2(1)
obtain U where U: "open U" "poincare_map p1 x0 ∈ U" "⋀x. x ∈ U ⟹ returns_to p2 x"
by force
have "continuous (at x0 within S) (poincare_map p1)"
by (rule has_derivative_continuous) (rule 1)
note [tendsto_intros] = this[unfolded continuous_within]
have "eventually (λx. poincare_map p1 x ∈ U) (at x0 within S)"
by (rule topological_tendstoD) (auto intro!: tendsto_eq_intros U)
then have evret_flow: "∀⇩F x in at x0 within S. returns_to p2 (flow0 x (return_time p1 x))"
unfolding poincare_map_def[symmetric]
apply eventually_elim
apply (rule U)
apply auto
done
moreover
have h_less_rt: "return_time p1 x0 < return_time p2 x0"
by (rule return_time_gt; fact)
then have "0 < return_time p2 x0 - return_time p1 x0"
by (simp )
from _ this have "∀⇩F x in at x0 within S. 0 < return_time p2 x - return_time p1 x"
apply (rule order_tendstoD)
using cont ‹(x0, _) ∈ _›
by (auto intro!: tendsto_eq_intros crt1 simp: continuous_within[symmetric] continuous_on_def)
then have evpm2: "∀⇩F x in at x0 within S. ∀s. 0 < s ⟶ s ≤ return_time p1 x ⟶ flow0 x s ∉ p2"
apply eventually_elim
apply safe
subgoal for x s
using return_time_least[of p2 x s]
by (auto simp add: return_time_pos_returns_to)
done
ultimately
have pm_eq_at: "∀⇩F x in at x0 within S.
poincare_map p2 (poincare_map p1 x) = poincare_map p2 x"
apply (eventually_elim)
apply (auto simp: poincare_map_def)
apply (subst flow_trans[symmetric])
apply (auto intro!: return_time_exivl)
apply (subst return_time_step)
by (auto simp: return_time_step
intro!: return_time_exivl return_time_pos)
from _ this have "(poincare_map p2 has_derivative blinfun_apply (D2 o⇩L D1)) (at x0 within S)"
apply (rule has_derivative_transform_eventually)
apply (rule has_derivative_compose[OF 1(4) 2(3), THEN has_derivative_eq_rhs])
by (auto simp: ‹x0 ∈ S› pm_eq)
moreover have "(poincare_map p2 x0, (D2 o⇩L D1) o⇩L d0) ∈ P2"
using 2(4) unfolding pm_eq blinfun_compose_assoc .
ultimately
show "∃D. (poincare_map p2 has_derivative blinfun_apply D) (at x0 within S) ∧
(poincare_map p2 x0, D o⇩L d0) ∈ P2"
by auto
show "0 < t ⟹ t < return_time p2 x0 ⟹ flow0 x0 t ∈ CZ" for t
apply (cases "t < return_time p1 x0")
subgoal
apply (drule 1)
using assms
by auto
subgoal
apply (cases "t = return_time p1 x0")
subgoal using 1(5) assms by (auto simp: poincare_map_def)
subgoal premises prems
proof -
have "flow0 x0 t = flow0 ?x0 (t - return_time p1 x0)"
unfolding poincare_map_def
apply (subst flow_trans[symmetric])
using prems
by (auto simp:
intro!: return_time_exivl 1 diff_existence_ivl_trans
less_return_time_imp_exivl[OF _ ret2])
also have "… ∈ CY"
apply (rule 2)
using prems
apply auto
using "1"(1) "2"(1) assms poincare_map_def ret2 return_time_exivl
return_time_least return_time_pos return_time_step
by auto
also have "… ⊆ CZ" using assms by auto
finally show "flow0 x0 t ∈ CZ"
by simp
qed
done
done
have rt_eq: "return_time p2 (poincare_map p1 x0) + return_time p1 x0 = return_time p2 x0"
apply (auto simp: poincare_map_def)
apply (subst return_time_step)
by (auto simp: return_time_step poincare_map_def[symmetric] not_p2
intro!: return_time_exivl return_time_pos 1 2)
have evrt_eq: "∀⇩F x in at x0 within S.
return_time p2 (poincare_map p1 x) + return_time p1 x = return_time p2 x"
using evret_flow evret1 evpm2
apply (eventually_elim)
apply (auto simp: poincare_map_def)
apply (subst return_time_step)
by (auto simp: return_time_step
intro!: return_time_exivl return_time_pos)
from _ evrt_eq
have "(return_time p2 has_derivative (λx. dR2 (blinfun_apply D1 x) + dR1 x)) (at x0 within S)"
by (rule has_derivative_transform_eventually)
(auto intro!: derivative_eq_intros has_derivative_compose[OF 1(4) 2(2)] 1(3) ‹x0 ∈ S›
simp: rt_eq)
then show "return_time p2 differentiable at x0 within S" by (auto intro!: differentiableI)
qed
lemma flowsto_poincare_trans:
assumes f: "flowsto X0 T CX P1"
assumes "poincare_mapsto p2 P1 UNIV CY P2"
assumes nn: "⋀t. t ∈ T ⟹ t ≥ 0"
assumes "fst ` CX ∪ CY ∪ fst ` P1 ⊆ CZ"
assumes "p2 ∩ (fst ` CX ∪ fst ` P1) = {}"
assumes [intro, simp]: "closed p2"
assumes cont: "⋀x d. (x, d) ∈ X0 ⟹ continuous (at x within S) (return_time p2)"
assumes subset: "fst ` X0 ⊆ S"
shows "poincare_mapsto p2 X0 S CZ P2"
unfolding poincare_mapsto_def
proof (auto, goal_cases)
fix x0 d0 assume x0: "(x0, d0) ∈ X0"
from flowstoE[OF f x0] obtain h where 1:
"h ∈ T" "h ∈ existence_ivl0 x0"
"(flow0 x0 h, Dflow x0 h o⇩L d0) ∈ P1" (is "(?x0, _) ∈ _")
"(⋀h'. h' ∈ {0<--<h} ⟹ (flow0 x0 h', Dflow x0 h' o⇩L d0) ∈ CX)"
by auto
then have CX: "(⋀h'. 0 < h' ⟹ h' < h ⟹ (flow0 x0 h', Dflow x0 h' o⇩L d0) ∈ CX)"
by (auto simp: nn open_segment_eq_real_ivl)
from 1 have "0 ≤ h" by (auto simp: nn)
from assms have CX_p2D: "x ∈ CX ⟹ fst x ∉ p2" for x by auto
from assms have P1_p2D: "x ∈ P1 ⟹ fst x ∉ p2" for x by auto
show "x0 ∈ S"
using x0 1 subset by auto
let ?D1 = "Dflow x0 h"
from assms(2) x0 ‹_ ∈ P1›
obtain D2 dR2 where 2:
"returns_to p2 ?x0"
"(return_time p2 has_derivative dR2) (at ?x0)"
"(poincare_map p2 has_derivative blinfun_apply D2) (at ?x0)"
"(poincare_map p2 ?x0, D2 o⇩L (?D1 o⇩L d0)) ∈ P2"
"⋀t. t∈{0<..<return_time p2 ?x0} ⟹ flow0 ?x0 t ∈ CY"
by (auto simp: poincare_mapsto_def differentiable_def)
{
assume pos: "h > 0"
have "∀⇩F t in at_right 0. t < h"
by (rule order_tendstoD) (auto intro!: return_time_pos 1 pos)
moreover have "∀⇩F t in at_right 0. 0 < t"
by (auto simp: eventually_at_filter)
ultimately have "∀⇩F t in at_right 0. flow0 x0 t ∉ p2"
by eventually_elim (use assms in ‹force dest: CX CX_p2D›)
} note evnotp2 = this
from 2(1)
show ret2: "returns_to p2 x0"
apply (cases "h = 0")
subgoal using 1 by auto
unfolding poincare_map_def
by (rule returns_to_earlierI)
(use evnotp2 ‹0 ≤ h› in ‹auto intro!: less_imp_le return_time_pos 1 return_time_exivl ›)
have not_p2: "0 < t ⟹ t ≤ h ⟹ flow0 x0 t ∉ p2" for t
using 1(1-3) CX[of t] assms(4) CX_p2D P1_p2D
by (cases "h = t") (auto simp: poincare_map_def set_eq_iff subset_iff)
have pm_eq: "poincare_map p2 x0 = poincare_map p2 ?x0"
apply (cases "h = 0", use 1 in force)
using not_p2 ‹0 ≤ h›
apply (auto simp: poincare_map_def)
apply (subst flow_trans[symmetric])
apply (auto intro!: return_time_exivl 1 2[unfolded poincare_map_def])
apply (subst return_time_step)
by (auto simp: return_time_step
intro!: return_time_exivl 1 2[unfolded poincare_map_def] return_time_pos)
have evret2: "∀⇩F x in at ?x0. returns_to p2 x"
by (auto intro!: eventually_returns_to_continuousI 2 has_derivative_continuous)
have "∀⇩F x in at x0. h ∈ existence_ivl0 x"
by (simp add: 1 eventually_mem_existence_ivl)
then have evex: "∀⇩F x in at x0 within S. h ∈ existence_ivl0 x"
by (auto simp: eventually_at)
moreover
from evret2[unfolded eventually_at_topological] 2(1)
obtain U where U: "open U" "flow0 x0 h ∈ U" "⋀x. x ∈ U ⟹ returns_to p2 x"
by force
note [tendsto_intros] = this[unfolded continuous_within]
have "eventually (λx. flow0 x h ∈ U) (at x0 within S)"
by (rule topological_tendstoD) (auto intro!: tendsto_eq_intros U 1)
then have evret_flow: "∀⇩F x in at x0 within S. returns_to p2 (flow0 x h)"
unfolding poincare_map_def[symmetric]
apply eventually_elim
apply (rule U)
apply auto
done
moreover
have h_less_rt: "h < return_time p2 x0"
by (rule return_time_gt; fact)
then have "0 < return_time p2 x0 - h"
by (simp )
from _ this have "∀⇩F x in at x0 within S. 0 < return_time p2 x - h"
apply (rule order_tendstoD)
using cont ‹(x0, _) ∈ _›
by (auto intro!: tendsto_eq_intros simp: continuous_within[symmetric] continuous_on_def)
then have evpm2: "∀⇩F x in at x0 within S. ∀s. 0 < s ⟶ s ≤ h ⟶ flow0 x s ∉ p2"
apply eventually_elim
apply safe
subgoal for x s
using return_time_least[of p2 x s]
by (auto simp add: return_time_pos_returns_to)
done
ultimately
have pm_eq_at: "∀⇩F x in at x0 within S.
poincare_map p2 (flow0 x h) = poincare_map p2 x"
apply (eventually_elim)
apply (cases "h = 0") subgoal by auto
apply (auto simp: poincare_map_def)
apply (subst flow_trans[symmetric])
apply (auto intro!: return_time_exivl)
apply (subst return_time_step)
using ‹0 ≤ h›
by (auto simp: return_time_step intro!: return_time_exivl return_time_pos)
from _ this have "(poincare_map p2 has_derivative blinfun_apply (D2 o⇩L ?D1)) (at x0 within S)"
apply (rule has_derivative_transform_eventually)
apply (rule has_derivative_at_withinI)
apply (rule has_derivative_compose[OF flow_has_space_derivative 2(3), THEN has_derivative_eq_rhs])
by (auto simp: ‹x0 ∈ S› pm_eq 1)
moreover have "(poincare_map p2 x0, (D2 o⇩L ?D1) o⇩L d0) ∈ P2"
using 2(4) unfolding pm_eq blinfun_compose_assoc .
ultimately
show "∃D. (poincare_map p2 has_derivative blinfun_apply D) (at x0 within S) ∧
(poincare_map p2 x0, D o⇩L d0) ∈ P2"
by auto
show "0 < t ⟹ t < return_time p2 x0 ⟹ flow0 x0 t ∈ CZ" for t
apply (cases "t < h")
subgoal
apply (drule CX)
using assms
by auto
subgoal
apply (cases "t = h")
subgoal using 1 assms by (auto simp: poincare_map_def)
subgoal premises prems
proof -
have "flow0 x0 t = flow0 ?x0 (t - h)"
unfolding poincare_map_def
apply (subst flow_trans[symmetric])
using prems
by (auto simp:
intro!: return_time_exivl 1 diff_existence_ivl_trans
less_return_time_imp_exivl[OF _ ret2])
also have "… ∈ CY"
apply (cases "h = 0")
subgoal using "1"(2) "2"(5) prems(1) prems(2) by auto
subgoal
apply (rule 2)
using prems
apply auto
apply (subst return_time_step)
apply (rule returns_to_laterI)
using ret2 ‹0 ≤ h› ‹h ∈ existence_ivl0 x0› not_p2
by auto
done
also have "… ⊆ CZ" using assms by auto
finally show "flow0 x0 t ∈ CZ"
by simp
qed
done
done
have rt_eq: "return_time p2 ?x0 + h = return_time p2 x0"
apply (cases "h = 0")
subgoal using 1 by auto
subgoal
apply (subst return_time_step)
using ‹0 ≤ h›
by (auto simp: return_time_step poincare_map_def[symmetric] not_p2
intro!: return_time_exivl return_time_pos 1 2)
done
have evrt_eq: "∀⇩F x in at x0 within S.
return_time p2 (flow0 x h) + h = return_time p2 x"
using evret_flow evpm2 evex
apply (eventually_elim)
apply (cases "h = 0")
subgoal using 1 by auto
subgoal
apply (subst return_time_step)
using ‹0 ≤ h›
by (auto simp: return_time_step
intro!: return_time_exivl return_time_pos)
done
from _ evrt_eq
have "(return_time p2 has_derivative (λx. dR2 (blinfun_apply ?D1 x))) (at x0 within S)"
apply (rule has_derivative_transform_eventually)
apply (rule has_derivative_at_withinI)
by (auto intro!: derivative_eq_intros has_derivative_compose[OF flow_has_space_derivative 2(2)] 1 ‹x0 ∈ S›
simp: rt_eq)
then show "return_time p2 differentiable at x0 within S" by (auto intro!: differentiableI)
qed
subsection ‹conditions for continuous return time›
definition "section s Ds S ⟷
(∀x. (s has_derivative blinfun_apply (Ds x)) (at x)) ∧
(∀x. isCont Ds x) ∧
(∀x ∈ S. s x = (0::real) ⟶ Ds x (f x) ≠ 0) ∧
closed S ∧ S ⊆ X"
lemma sectionD:
assumes "section s Ds S"
shows "(s has_derivative blinfun_apply (Ds x)) (at x)"
"isCont Ds x"
"x ∈ S ⟹ s x = 0 ⟹ Ds x (f x) ≠ 0"
"closed S" "S ⊆ X"
using assms by (auto simp: section_def)
definition "transversal p ⟷ (∀x ∈ p. ∀⇩F t in at_right 0. flow0 x t ∉ p)"
lemma transversalD: "transversal p ⟹ x ∈ p ⟹ ∀⇩F t in at_right 0. flow0 x t ∉ p"
by (auto simp: transversal_def)
lemma transversal_section:
fixes c::real
assumes "section s Ds S"
shows "transversal {x ∈ S. s x = 0}"
using assms
unfolding section_def transversal_def
proof (safe, goal_cases)
case (1 x)
then have "x ∈ X" by auto
have "∀⇩F t in at_right 0. flow0 x t ∉ {xa ∈ S. s xa = 0}"
by (rule flow_avoids_surface_eventually_at_right)
(rule disjI2 assms 1[rule_format] refl ‹x ∈ X›)+
then show ?case
by simp
qed
lemma section_closed[intro, simp]: "section s Ds S ⟹ closed {x ∈ S. s x = 0}"
by (auto intro!: closed_levelset_within simp: section_def
intro!: has_derivative_continuous_on has_derivative_at_withinI[where s=S])
lemma return_time_continuous_belowI:
assumes ft: "flowsto X0 T CX X1"
assumes pos: "⋀t. t ∈ T ⟹ t > 0"
assumes X0: "fst ` X0 ⊆ {x ∈ S. s x = 0}"
assumes CX: "fst ` CX ∩ {x ∈ S. s x = 0} = {}"
assumes X1: "fst ` X1 ⊆ {x ∈ S. s x = 0}"
assumes sec: "section s Ds S"
assumes nz: "⋀x. x ∈ S ⟹ s x = 0 ⟹ Ds x (f x) ≠ 0"
assumes Dneg: "(λx. (Ds x) (f x)) ` fst ` X0 ⊆ {..<0}"
assumes rel_int: "⋀x. x ∈ fst ` X1 ⟹ ∀⇩F x in at x. s x = 0 ⟶ x ∈ S"
assumes "(x, d) ∈ X0"
shows "continuous (at x within {x. s x ≤ 0}) (return_time {x ∈ S. s x = 0})"
proof (rule return_time_continuous_below)
from assms have "x ∈ S" "s x = 0" "x ∈ {x ∈ S. s x = 0}" by auto
note cs = section_closed[OF sec]
note sectionD[OF sec]
from flowstoE[OF ft ‹(x, d) ∈ X0›] obtain h
where h: "h ∈ T"
"h ∈ existence_ivl0 x"
"(flow0 x h, Dflow x h o⇩L d) ∈ X1"
"(⋀h'. h' ∈ {0<--<h} ⟹ (flow0 x h', Dflow x h' o⇩L d) ∈ CX)"
by blast
show ret: "returns_to {x ∈ S. s x = 0} x"
apply (rule returns_toI)
apply (rule pos)
apply (rule h)
subgoal by (rule h)
subgoal using h(3) X1 by auto
subgoal apply (intro transversalD) apply (rule transversal_section) apply (rule sec)
apply fact
done
subgoal by fact
done
show "(s has_derivative blinfun_apply (Ds x)) (at x)" for x by fact
show "closed S" by fact
show "isCont Ds x" for x by fact
show "x ∈ S" "s x = 0" by fact+
let ?p = "poincare_map {x ∈ S. s x = 0} x"
have "?p ∈ {x ∈ S. s x = 0}" using poincare_map_returns[OF ret cs] .
with nz show "Ds ?p (f ?p) ≠ 0" by auto
from Dneg ‹(x, _) ∈ X0› show "Ds x (f x) < 0" by force
from ‹_ ∈ X1› X1 CX h
have "return_time {x ∈ S. s x = 0} x = h"
by (fastforce intro!: return_time_eqI cs pos h simp: open_segment_eq_real_ivl)
then have "?p ∈ fst ` X1"
using ‹_ ∈ X1› by (force simp: poincare_map_def)
from rel_int[OF this] show " ∀⇩F x in at (poincare_map {x ∈ S. s x = 0} x). s x = 0 ⟶ x ∈ S"
by auto
qed
end
end
Theory Flow_Congs
theory Flow_Congs
imports Reachability_Analysis
begin
lemma lipschitz_on_congI:
assumes "L'-lipschitz_on s' g'"
assumes "s' = s"
assumes "L' ≤ L"
assumes "⋀x y. x ∈ s ⟹ g' x = g x"
shows "L-lipschitz_on s g"
using assms
by (auto simp: lipschitz_on_def intro!: order_trans[OF _ mult_right_mono[OF ‹L' ≤ L›]])
lemma local_lipschitz_congI:
assumes "local_lipschitz s' t' g'"
assumes "s' = s"
assumes "t' = t"
assumes "⋀x y. x ∈ s ⟹ y ∈ t ⟹ g' x y = g x y"
shows "local_lipschitz s t g"
proof -
from assms have "local_lipschitz s t g'"
by (auto simp: local_lipschitz_def)
then show ?thesis
apply (auto simp: local_lipschitz_def)
apply (drule_tac bspec, assumption)
apply (drule_tac bspec, assumption)
apply auto
subgoal for x y u L
apply (rule exI[where x=u])
apply (auto intro!: exI[where x=L])
apply (drule bspec)
apply simp
apply (rule lipschitz_on_congI, assumption, rule refl, rule order_refl)
using assms
apply (auto)
done
done
qed
context ll_on_open_it
begin
context fixes S Y g assumes cong: "X = Y" "T = S" "⋀x t. x ∈ Y ⟹ t ∈ S ⟹ f t x = g t x"
begin
lemma ll_on_open_congI: "ll_on_open S g Y"
proof -
interpret Y: ll_on_open_it S f Y t0
apply (subst cong(1)[symmetric])
apply (subst cong(2)[symmetric])
by unfold_locales
show ?thesis
apply standard
subgoal
using local_lipschitz
apply (rule local_lipschitz_congI)
using cong by simp_all
subgoal apply (subst continuous_on_cong) prefer 3 apply (rule cont)
using cong by (auto)
subgoal using open_domain by (auto simp: cong)
subgoal using open_domain by (auto simp: cong)
done
qed
lemma existence_ivl_subsetI:
assumes t: "t ∈ existence_ivl t0 x0"
shows "t ∈ ll_on_open.existence_ivl S g Y t0 x0"
proof -
from assms have ‹t0 ∈ T› "x0 ∈ X"
by (rule mem_existence_ivl_iv_defined)+
interpret Y: ll_on_open S g Y by (rule ll_on_open_congI)
have "(flow t0 x0 solves_ode f) (existence_ivl t0 x0) X"
by (rule flow_solves_ode) (auto simp: ‹x0 ∈ X› ‹t0 ∈ T›)
then have "(flow t0 x0 solves_ode f) {t0--t} X"
by (rule solves_ode_on_subset)
(auto simp add: t local.closed_segment_subset_existence_ivl)
then have "(flow t0 x0 solves_ode g) {t0--t} Y"
apply (rule solves_ode_congI)
apply (auto intro!: assms cong)
using ‹(flow t0 x0 solves_ode f) {t0--t} X› local.cong(1) solves_ode_domainD apply blast
using ‹t0 ∈ T› assms closed_segment_subset_domainI general.mem_existence_ivl_subset local.cong(2)
by blast
then show ?thesis
apply (rule Y.existence_ivl_maximal_segment)
subgoal by (simp add: ‹t0 ∈ T› ‹x0 ∈ X›)
apply (subst cong[symmetric])
using ‹t0 ∈ T› assms closed_segment_subset_domainI general.mem_existence_ivl_subset local.cong(2)
by blast
qed
lemma existence_ivl_cong:
shows "existence_ivl t0 x0 = ll_on_open.existence_ivl S g Y t0 x0"
proof -
interpret Y: ll_on_open S g Y by (rule ll_on_open_congI)
show ?thesis
apply (auto )
subgoal by (rule existence_ivl_subsetI)
subgoal
apply (rule Y.existence_ivl_subsetI)
using cong
by auto
done
qed
lemma flow_cong:
assumes "t ∈ existence_ivl t0 x0"
shows "flow t0 x0 t = ll_on_open.flow S g Y t0 x0 t"
proof -
interpret Y: ll_on_open S g Y by (rule ll_on_open_congI)
from assms have "t0 ∈ T" "x0 ∈ X"
by (rule mem_existence_ivl_iv_defined)+
from cong ‹x0 ∈ X› have "x0 ∈ Y" by auto
from cong ‹t0 ∈ T› have "t0 ∈ S" by auto
show ?thesis
apply (rule Y.equals_flowI[where T'="existence_ivl t0 x0"])
subgoal using ‹t0 ∈ T› ‹x0 ∈ X› by auto
subgoal using ‹x0 ∈ X› by auto
subgoal by (auto simp: existence_ivl_cong ‹x0 ∈ X›)
subgoal
apply (rule solves_ode_congI)
apply (rule flow_solves_ode[OF ‹t0 ∈ T› ‹x0 ∈ X›])
using existence_ivl_subset[of x0]
by (auto simp: cong(2)[symmetric] cong(1)[symmetric] assms flow_in_domain intro!: cong)
subgoal using ‹t0 ∈ S› ‹t0 ∈ T› ‹x0 ∈ X› ‹x0 ∈ Y›
by (auto simp:)
subgoal by fact
done
qed
end
end
context auto_ll_on_open begin
context fixes Y g assumes cong: "X = Y" "⋀x t. x ∈ Y ⟹ f x = g x"
begin
lemma auto_ll_on_open_congI: "auto_ll_on_open g Y"
apply unfold_locales
subgoal
using local_lipschitz
apply (rule local_lipschitz_congI)
using cong by auto
subgoal
using open_domain
using cong by auto
done
lemma existence_ivl0_cong:
shows "existence_ivl0 x0 = auto_ll_on_open.existence_ivl0 g Y x0"
proof -
interpret Y: auto_ll_on_open g Y by (rule auto_ll_on_open_congI)
show ?thesis
unfolding Y.existence_ivl0_def
apply (rule existence_ivl_cong)
using cong by auto
qed
lemma flow0_cong:
assumes "t ∈ existence_ivl0 x0"
shows "flow0 x0 t = auto_ll_on_open.flow0 g Y x0 t"
proof -
interpret Y: auto_ll_on_open g Y by (rule auto_ll_on_open_congI)
show ?thesis
unfolding Y.flow0_def
apply (rule flow_cong)
using cong assms by auto
qed
end
end
context c1_on_open_euclidean begin
context fixes Y g assumes cong: "X = Y" "⋀x t. x ∈ Y ⟹ f x = g x"
begin
lemma f'_cong: "(g has_derivative blinfun_apply (f' x)) (at x)" if "x ∈ Y"
proof -
from derivative_rhs[of x] that cong
have "(f has_derivative blinfun_apply (f' x)) (at x within Y)"
by (auto intro!: has_derivative_at_withinI)
then have "(g has_derivative blinfun_apply (f' x)) (at x within Y)"
by (rule has_derivative_transform_within[OF _ zero_less_one that])
(auto simp: cong)
then show ?thesis
using at_within_open[OF that] cong open_dom
by (auto simp: )
qed
lemma c1_on_open_euclidean_congI: "c1_on_open_euclidean g f' Y"
proof -
interpret Y: c1_on_open_euclidean f f' Y unfolding cong[symmetric] by unfold_locales
show ?thesis
apply standard
subgoal using cong by simp
subgoal by (rule f'_cong)
subgoal by (simp add: cong[symmetric] continuous_derivative)
done
qed
lemma vareq_cong: "vareq x0 t = c1_on_open_euclidean.vareq g f' Y x0 t"
if "t ∈ existence_ivl0 x0"
proof -
interpret Y: c1_on_open_euclidean g f' Y by (rule c1_on_open_euclidean_congI)
show ?thesis
unfolding vareq_def Y.vareq_def
apply (rule arg_cong[where f=f'])
apply (rule flow0_cong)
using cong that by auto
qed
lemma Dflow_cong:
assumes "t ∈ existence_ivl0 x0"
shows "Dflow x0 t = c1_on_open_euclidean.Dflow g f' Y x0 t"
proof -
interpret Y: c1_on_open_euclidean g f' Y by (rule c1_on_open_euclidean_congI)
from assms have "x0 ∈ X"
by (rule mem_existence_ivl_iv_defined)
from cong ‹x0 ∈ X› have "x0 ∈ Y" by auto
show ?thesis
unfolding Dflow_def Y.Dflow_def
apply (rule mvar.equals_flowI[symmetric, OF _ _ order_refl])
subgoal using ‹x0 ∈ X› by auto
subgoal using ‹x0 ∈ X› by auto
subgoal
apply (rule solves_ode_congI)
apply (rule Y.mvar.flow_solves_ode)
prefer 3 apply (rule refl)
subgoal using ‹x0 ∈ X› ‹x0 ∈ Y› by auto
subgoal using ‹x0 ∈ X› ‹x0 ∈ Y› by auto
subgoal for t
apply (subst vareq_cong)
apply (subst (asm) Y.mvar_existence_ivl_eq_existence_ivl)
subgoal using ‹x0 ∈ Y› by simp
subgoal
using cong
by (subst (asm) existence_ivl0_cong[symmetric]) auto
subgoal using ‹x0 ∈ Y› by simp
done
subgoal using ‹x0 ∈ X› ‹x0 ∈ Y›
apply (subst mvar_existence_ivl_eq_existence_ivl)
subgoal by simp
apply (subst Y.mvar_existence_ivl_eq_existence_ivl)
subgoal by simp
using cong
by (subst existence_ivl0_cong[symmetric]) auto
subgoal by simp
done
subgoal using ‹x0 ∈ X› ‹x0 ∈ Y› by auto
subgoal
apply (subst mvar_existence_ivl_eq_existence_ivl)
apply auto
apply fact+
done
done
qed
lemma flowsto_congI1:
assumes "flowsto A B C D"
shows "c1_on_open_euclidean.flowsto g f' Y A B C D"
proof -
interpret Y: c1_on_open_euclidean g f' Y by (rule c1_on_open_euclidean_congI)
show ?thesis
using assms
unfolding flowsto_def Y.flowsto_def
apply (auto simp: existence_ivl0_cong[OF cong] flow0_cong[OF cong])
apply (drule bspec, assumption)
apply clarsimp
apply (rule bexI)
apply (rule conjI)
apply assumption
apply (subst flow0_cong[symmetric, OF cong])
apply auto
apply (subst existence_ivl0_cong[OF cong])
apply auto
apply (subst Dflow_cong[symmetric])
apply auto
apply (subst existence_ivl0_cong[OF cong])
apply auto
apply (drule bspec, assumption)
apply (subst flow0_cong[symmetric, OF cong])
apply auto
apply (subst existence_ivl0_cong[OF cong])
apply auto defer
apply (subst Dflow_cong[symmetric])
apply auto
apply (subst existence_ivl0_cong[OF cong])
apply auto
apply (drule Y.closed_segment_subset_existence_ivl;
auto simp: open_segment_eq_real_ivl closed_segment_eq_real_ivl split: if_splits)+
done
qed
lemma flowsto_congI2:
assumes "c1_on_open_euclidean.flowsto g f' Y A B C D"
shows "flowsto A B C D"
proof -
interpret Y: c1_on_open_euclidean g f' Y by (rule c1_on_open_euclidean_congI)
show ?thesis
apply (rule Y.flowsto_congI1)
using assms
by (auto simp: cong)
qed
lemma flowsto_congI: "flowsto A B C D = c1_on_open_euclidean.flowsto g f' Y A B C D"
using flowsto_congI1[of A B C D] flowsto_congI2[of A B C D] by auto
lemma
returns_to_congI1:
assumes "returns_to A x"
shows "auto_ll_on_open.returns_to g Y A x"
proof -
interpret Y: c1_on_open_euclidean g f' Y by (rule c1_on_open_euclidean_congI)
from assms obtain t where t:
"∀⇩F t in at_right 0. flow0 x t ∉ A"
"0 < t" "t ∈ existence_ivl0 x" "flow0 x t ∈ A"
by (auto simp: returns_to_def)
note t(1)
moreover
have "∀⇩F s in at_right 0. s < t"
using tendsto_ident_at ‹0 < t›
by (rule order_tendstoD)
moreover have "∀⇩F s in at_right 0. 0 < s"
by (auto simp: eventually_at_topological)
ultimately have "∀⇩F t in at_right 0. Y.flow0 x t ∉ A"
apply eventually_elim
using ivl_subset_existence_ivl[OF ‹t ∈ _›]
apply (subst (asm) flow0_cong[OF cong])
by (auto simp: )
moreover have "∃t>0. t ∈ Y.existence_ivl0 x ∧ Y.flow0 x t ∈ A"
using t
by (auto intro!: exI[where x=t] simp: flow0_cong[OF cong] existence_ivl0_cong[OF cong])
ultimately show ?thesis
by (auto simp: Y.returns_to_def)
qed
lemma
returns_to_congI2:
assumes "auto_ll_on_open.returns_to g Y x A"
shows "returns_to x A"
proof -
interpret Y: c1_on_open_euclidean g f' Y by (rule c1_on_open_euclidean_congI)
show ?thesis
by (rule Y.returns_to_congI1) (auto simp: assms cong)
qed
lemma returns_to_cong: "auto_ll_on_open.returns_to g Y A x = returns_to A x"
using returns_to_congI1 returns_to_congI2 by blast
lemma
return_time_cong:
shows "return_time A x = auto_ll_on_open.return_time g Y A x"
proof -
interpret Y: c1_on_open_euclidean g f' Y by (rule c1_on_open_euclidean_congI)
have P_eq: "0 < t ∧ t ∈ existence_ivl0 x ∧ flow0 x t ∈ A ∧ (∀s∈{0<..<t}. flow0 x s ∉ A) ⟷
0 < t ∧ t ∈ Y.existence_ivl0 x ∧ Y.flow0 x t ∈ A ∧ (∀s∈{0<..<t}. Y.flow0 x s ∉ A)"
for t
using ivl_subset_existence_ivl[of t x]
apply (auto simp: existence_ivl0_cong[OF cong] flow0_cong[OF cong])
apply (drule bspec)
apply force
apply (subst (asm) flow0_cong[OF cong])
apply auto
apply (auto simp: existence_ivl0_cong[OF cong, symmetric] flow0_cong[OF cong])
apply (subst (asm) flow0_cong[OF cong])
apply auto
done
show ?thesis
unfolding return_time_def Y.return_time_def
by (auto simp: returns_to_cong P_eq)
qed
lemma poincare_mapsto_congI1:
assumes "poincare_mapsto A B C D E" "closed A"
shows "c1_on_open_euclidean.poincare_mapsto g Y A B C D E"
proof -
interpret Y: c1_on_open_euclidean g f' Y by (rule c1_on_open_euclidean_congI)
show ?thesis
using assms
unfolding poincare_mapsto_def Y.poincare_mapsto_def
apply auto
subgoal for a b
by (rule returns_to_congI1) auto
subgoal for a b
by (subst return_time_cong[abs_def, symmetric]) auto
subgoal for a b
unfolding poincare_map_def Y.poincare_map_def
apply (drule bspec, assumption)
apply safe
subgoal for D
apply (auto intro!: exI[where x=D])
subgoal premises prems
proof -
have "∀⇩F y in at a within C. returns_to A y"
apply (rule eventually_returns_to_continuousI)
apply fact apply fact
apply (rule differentiable_imp_continuous_within)
apply fact
done
moreover have "∀⇩F y in at a within C. y ∈ C"
by (auto simp: eventually_at_filter)
ultimately have "∀⇩F x' in at a within C. flow0 x' (return_time A x') = Y.flow0 x' (Y.return_time A x')"
proof eventually_elim
case (elim x')
then show ?case
apply (subst flow0_cong[OF cong, symmetric], force)
apply (subst return_time_cong[symmetric])
using prems
apply (auto intro!: return_time_exivl)
apply (subst return_time_cong[symmetric])
apply auto
done
qed
with prems(7)
show ?thesis
apply (rule has_derivative_transform_eventually)
using prems
apply (subst flow0_cong[OF cong, symmetric], force)
apply (subst return_time_cong[symmetric])
using prems
apply (auto intro!: return_time_exivl)
apply (subst return_time_cong[symmetric])
apply auto
done
qed
subgoal
apply (subst flow0_cong[OF cong, symmetric], force)
apply (subst return_time_cong[symmetric])
apply (auto intro!: return_time_exivl)
apply (subst return_time_cong[symmetric])
apply auto
done
done
done
subgoal for a b t
apply (drule bspec, assumption)
apply (subst flow0_cong[OF cong, symmetric])
apply auto
apply (subst (asm) return_time_cong[symmetric])
apply (rule less_return_time_imp_exivl)
apply (rule less_imp_le, assumption)
apply (auto simp: return_time_cong)
done
done
qed
lemma poincare_mapsto_congI2:
assumes "c1_on_open_euclidean.poincare_mapsto g Y A B C D E" "closed A"
shows "poincare_mapsto A B C D E"
proof -
interpret Y: c1_on_open_euclidean g f' Y by (rule c1_on_open_euclidean_congI)
show ?thesis
apply (rule Y.poincare_mapsto_congI1)
using assms
by (auto simp: cong)
qed
lemma poincare_mapsto_cong: "closed A ⟹
poincare_mapsto A B C D E = c1_on_open_euclidean.poincare_mapsto g Y A B C D E"
using poincare_mapsto_congI1[of A B C] poincare_mapsto_congI2[of A B C] by auto
end
end
end
Theory Cones
theory Cones
imports
"HOL-Analysis.Analysis"
Triangle.Triangle
"../ODE_Auxiliarities"
begin
lemma arcsin_eq_zero_iff[simp]: "-1 ≤ x ⟹ x ≤ 1 ⟹ arcsin x = 0 ⟷ x = 0"
using sin_arcsin by fastforce
definition conemem :: "'a::real_vector ⇒ 'a ⇒ real ⇒ 'a" where "conemem u v t = cos t *⇩R u + sin t *⇩R v"
definition "conesegment u v = conemem u v ` {0.. pi / 2}"
lemma
bounded_linear_image_conemem:
assumes "bounded_linear F"
shows "F (conemem u v t) = conemem (F u) (F v) t"
proof -
from assms interpret bounded_linear F .
show ?thesis
by (auto simp: conemem_def[abs_def] cone_hull_expl closed_segment_def add scaleR)
qed
lemma
bounded_linear_image_conesegment:
assumes "bounded_linear F"
shows "F ` conesegment u v = conesegment (F u) (F v)"
proof -
from assms interpret bounded_linear F .
show ?thesis
apply (auto simp: conesegment_def conemem_def[abs_def] cone_hull_expl closed_segment_def add scaleR)
apply (auto simp: add[symmetric] scaleR[symmetric])
done
qed
lemma discriminant: "a * x⇧2 + b * x + c = (0::real) ⟹ 0 ≤ b⇧2 - 4 * a * c"
by (sos "(((A<0 * R<1) + (R<1 * (R<1 * [2*a*x + b]^2))))")
lemma quadratic_eq_factoring:
assumes D: "D = b⇧2 - 4 * a * c"
assumes nn: "0 ≤ D"
assumes x1: "x⇩1 = (-b + sqrt D) / (2 * a)"
assumes x2: "x⇩2 = (-b - sqrt D) / (2 * a)"
assumes a: "a ≠ 0"
shows "a * x⇧2 + b * x + c = a * (x - x⇩1) * (x - x⇩2)"
using nn
by (simp add: D x1 x2)
(simp add: assms algebra_simps power2_eq_square power3_eq_cube divide_simps)
lemma quadratic_eq_zeroes_iff:
assumes D: "D = b⇧2 - 4 * a * c"
assumes x1: "x⇩1 = (-b + sqrt D) / (2 * a)"
assumes x2: "x⇩2 = (-b - sqrt D) / (2 * a)"
assumes a: "a ≠ 0"
shows "a * x⇧2 + b * x + c = 0 ⟷ (D ≥ 0 ∧ (x = x⇩1 ∨ x = x⇩2))" (is "?z ⟷ _")
using quadratic_eq_factoring[OF D _ x1 x2 a, of x] discriminant[of a x b c] a
by (auto simp: D)
lemma quadratic_ex_zero_iff:
"(∃x. a * x⇧2 + b * x + c = 0) ⟷ (a ≠ 0 ∧ b⇧2 - 4 * a * c ≥ 0 ∨ a = 0 ∧ (b = 0 ⟶ c = 0))"
for a b c::real
apply (cases "a = 0")
subgoal by (auto simp: intro: exI[where x="- c / b"])
subgoal by (subst quadratic_eq_zeroes_iff[OF refl refl refl]) auto
done
lemma Cauchy_Schwarz_eq_iff:
shows "(inner x y)⇧2 = inner x x * inner y y ⟷ ((∃k. x = k *⇩R y) ∨ y = 0)"
proof safe
assume eq: "(x ∙ y)⇧2 = x ∙ x * (y ∙ y)" and "y ≠ 0"
define f where "f ≡ λl. inner (x - l *⇩R y) (x - l *⇩R y)"
have f_quadratic: "f l = inner y y * l⇧2 + - 2 * inner x y * l + inner x x" for l
by (auto simp: f_def algebra_simps power2_eq_square inner_commute)
have "∃l. f l = 0"
unfolding f_quadratic quadratic_ex_zero_iff
using ‹y ≠ 0›
by (auto simp: eq)
then show "(∃k. x = k *⇩R y)"
by (auto simp: f_def)
qed (auto simp: power2_eq_square)
lemma Cauchy_Schwarz_strict_ineq:
"(inner x y)⇧2 < inner x x * inner y y" if "y ≠ 0" "⋀k. x ≠ k *⇩R y"
apply (rule neq_le_trans)
subgoal
using that
unfolding Cauchy_Schwarz_eq_iff
by auto
subgoal by (rule Cauchy_Schwarz_ineq)
done
lemma Cauchy_Schwarz_eq2_iff:
"¦inner x y¦ = norm x * norm y ⟷ ((∃k. x = k *⇩R y) ∨ y = 0)"
using Cauchy_Schwarz_eq_iff[of x y]
by (subst power_eq_iff_eq_base[symmetric, where n = 2])
(simp_all add: dot_square_norm power_mult_distrib)
lemma Cauchy_Schwarz_strict_ineq2:
"¦inner x y¦ < norm x * norm y" if "y ≠ 0" "⋀k. x ≠ k *⇩R y"
apply (rule neq_le_trans)
subgoal
using that
unfolding Cauchy_Schwarz_eq2_iff
by auto
subgoal by (rule Cauchy_Schwarz_ineq2)
done
lemma gt_minus_one_absI: "abs k < 1 ⟹ - 1 < k" for k::real
by auto
lemma gt_one_absI: "abs k < 1 ⟹ k < 1" for k::real
by auto
lemma abs_impossible:
"¦y1¦ < x1 ⟹ ¦y2¦ < x2 ⟹ x1 * x2 + y1 * y2 ≠ 0" for x1 x2::real
proof goal_cases
case 1
have "- y1 * y2 ≤ abs y1 * abs y2"
by (metis abs_ge_minus_self abs_mult mult.commute mult_minus_right)
also have "… < x1 * x2"
apply (rule mult_strict_mono)
using 1 by auto
finally show ?case by auto
qed
lemma vangle_eq_arctan_minus:
assumes ij: "i ∈ Basis" "j ∈ Basis" and ij_neq: "i ≠ j"
assumes xy1: "¦y1¦ < x1"
assumes xy2: "¦y2¦ < x2"
assumes less: "y2 / x2 > y1 / x1"
shows "vangle (x1 *⇩R i + y1 *⇩R j) (x2 *⇩R i + y2 *⇩R j) = arctan (y2 / x2) - arctan (y1 / x1)"
(is "vangle ?u ?v = _")
proof -
from assms have less2: "x2 * y1 - x1 * y2 < 0"
by (auto simp: divide_simps abs_real_def algebra_simps split: if_splits)
have norm_eucl: "norm (x *⇩R i + y *⇩R j) = sqrt ((norm x)⇧2 + (norm y)⇧2)" for x y
apply (subst norm_eq_sqrt_inner)
using ij ij_neq
by (auto simp: inner_simps inner_Basis power2_eq_square)
have nonzeroes: "x1 *⇩R i + y1 *⇩R j ≠ 0" "x2 *⇩R i + y2 *⇩R j ≠ 0"
apply (auto simp: euclidean_eq_iff[where 'a='a] inner_simps intro!: bexI[where x=i])
using assms
by (auto simp: inner_Basis)
have indep: "x1 *⇩R i + y1 *⇩R j ≠ k *⇩R (x2 *⇩R i + y2 *⇩R j)" for k
proof
assume "x1 *⇩R i + y1 *⇩R j = k *⇩R (x2 *⇩R i + y2 *⇩R j)"
then have "x1 / x2 = k" "y1 = k * y2"
using ij ij_neq xy1 xy2
apply (auto simp: abs_real_def divide_simps algebra_simps euclidean_eq_iff[where 'a='a] inner_simps
split: if_splits)
by (auto simp: inner_Basis split: if_splits)
then have "y1 = x1 / x2 * y2" by simp
with less show False using xy1 by (auto split: if_splits)
qed
have "((x1⇧2 + y1⇧2) * (x2⇧2 + y2⇧2) *
(1 - ((x1 *⇩R i + y1 *⇩R j) ∙ (x2 *⇩R i + y2 *⇩R j))⇧2 / ((x1⇧2 + y1⇧2) * (x2⇧2 + y2⇧2)))) =
((x1⇧2 + y1⇧2) * (x2⇧2 + y2⇧2) *
(1 - (x1 * x2 + y1 * y2)⇧2 / ((x1⇧2 + y1⇧2) * (x2⇧2 + y2⇧2))))"
using ij_neq ij
by (auto simp: algebra_simps divide_simps inner_simps inner_Basis)
also have "… = (x1⇧2 + y1⇧2) * (x2⇧2 + y2⇧2) - (x1 * x2 + y1 * y2)⇧2"
unfolding right_diff_distrib by simp
also have "… = (x2 * y1 - x1 * y2)^2"
by (auto simp: algebra_simps power2_eq_square)
also have "sqrt … = ¦x2 * y1 - x1 * y2¦"
by simp
also have "… = x1 * y2 - x2 * y1"
using less2
by (simp add: abs_real_def)
finally have sqrt_eq: "sqrt ((x1⇧2 + y1⇧2) * (x2⇧2 + y2⇧2) *
(1 - ((x1 *⇩R i + y1 *⇩R j) ∙ (x2 *⇩R i + y2 *⇩R j))⇧2 / ((x1⇧2 + y1⇧2) * (x2⇧2 + y2⇧2)))) =
x1 * y2 - x2 * y1"
.
show ?thesis
using ij xy1 xy2
unfolding vangle_def
apply (subst arccos_arctan)
subgoal
apply (rule gt_minus_one_absI)
apply (simp add: )
apply (subst pos_divide_less_eq)
subgoal
apply (rule mult_pos_pos)
using nonzeroes
by auto
subgoal
apply simp
apply (rule Cauchy_Schwarz_strict_ineq2)
using nonzeroes indep
by auto
done
subgoal
apply (rule gt_one_absI)
apply (simp add: )
apply (subst pos_divide_less_eq)
subgoal
apply (rule mult_pos_pos)
using nonzeroes
by auto
subgoal
apply simp
apply (rule Cauchy_Schwarz_strict_ineq2)
using nonzeroes indep
by auto
done
subgoal
apply (auto simp: nonzeroes)
apply (subst (3) diff_conv_add_uminus)
apply (subst arctan_minus[symmetric])
apply (subst arctan_add)
apply force
apply force
apply (subst arctan_inverse[symmetric])
subgoal
apply (rule divide_pos_pos)
subgoal
apply (auto simp add: inner_simps inner_Basis algebra_simps )
apply (thin_tac "_ ∈ Basis")+ apply (thin_tac "j = i")
apply (sos "((((A<0 * (A<1 * (A<2 * A<3))) * R<1) + ((A<=0 * (A<0 * (A<2 * R<1))) * (R<1 * [1]^2))))")
apply (thin_tac "_ ∈ Basis")+ apply (thin_tac "j ≠ i")
by (sos "((((A<0 * (A<1 * (A<2 * A<3))) * R<1) + (((A<2 * (A<3 * R<1)) * (R<1/3 * [y1]^2)) + (((A<1 * (A<3 * R<1)) * ((R<1/12 * [x2 + y1]^2) + (R<1/12 * [x1 + y2]^2))) + (((A<1 * (A<2 * R<1)) * (R<1/12 * [~1*x1 + x2 + y1 + y2]^2)) + (((A<0 * (A<3 * R<1)) * (R<1/12 * [~1*x1 + x2 + ~1*y1 + ~1*y2]^2)) + (((A<0 * (A<2 * R<1)) * ((R<1/12 * [x2 + ~1*y1]^2) + (R<1/12 * [~1*x1 + y2]^2))) + (((A<0 * (A<1 * R<1)) * (R<1/3 * [y2]^2)) + ((A<=0 * R<1) * (R<1/3 * [x1 + x2]^2))))))))))")
subgoal
apply (intro mult_pos_pos)
using nonzeroes indep
apply auto
apply (rule gt_one_absI)
apply (simp add: power_divide power_mult_distrib power2_norm_eq_inner)
apply (rule Cauchy_Schwarz_strict_ineq)
apply auto
done
done
subgoal
apply (rule arg_cong[where f=arctan])
using nonzeroes ij_neq
apply (auto simp: norm_eucl)
apply (subst real_sqrt_mult[symmetric])
apply (subst real_sqrt_mult[symmetric])
apply (subst real_sqrt_mult[symmetric])
apply (subst power_divide)
apply (subst real_sqrt_pow2)
apply simp
apply (subst nonzero_divide_eq_eq)
subgoal
apply (auto simp: algebra_simps inner_simps inner_Basis)
by (auto simp: algebra_simps divide_simps abs_real_def abs_impossible)
apply (subst sqrt_eq)
apply (auto simp: algebra_simps inner_simps inner_Basis)
apply (auto simp: algebra_simps divide_simps abs_real_def abs_impossible)
by (auto split: if_splits)
done
done
qed
lemma vangle_le_pi2: "0 ≤ u ∙ v ⟹ vangle u v ≤ pi/2"
unfolding vangle_def atLeastAtMost_iff
apply (simp del: le_divide_eq_numeral1)
apply (intro impI arccos_le_pi2 arccos_lbound)
using Cauchy_Schwarz_ineq2[of u v]
by (auto simp: algebra_simps)
lemma inner_eq_vangle: "u ∙ v = cos (vangle u v) * (norm u * norm v)"
by (simp add: cos_vangle)
lemma vangle_scaleR_self:
"vangle (k *⇩R v) v = (if k = 0 ∨ v = 0 then pi / 2 else if k > 0 then 0 else pi)"
"vangle v (k *⇩R v) = (if k = 0 ∨ v = 0 then pi / 2 else if k > 0 then 0 else pi)"
by (auto simp: vangle_def dot_square_norm power2_eq_square)
lemma vangle_scaleR:
"vangle (k *⇩R v) w = vangle v w" "vangle w (k *⇩R v) = vangle w v" if "k > 0"
using that
by (auto simp: vangle_def)
lemma cos_vangle_eq_zero_iff_vangle:
"cos (vangle u v) = 0 ⟷ (u = 0 ∨ v = 0 ∨ u ∙ v = 0)"
using Cauchy_Schwarz_ineq2[of u v]
by (auto simp: vangle_def divide_simps algebra_split_simps split: if_splits)
lemma ortho_imp_angle_pi_half: "u ∙ v = 0 ⟹ vangle u v = pi / 2"
using orthogonal_iff_vangle[of u v]
by (auto simp: orthogonal_def)
lemma arccos_eq_zero_iff: "arccos x = 0 ⟷ x = 1" if "-1 ≤ x" "x ≤ 1"
using that
apply auto
using cos_arccos by fastforce
lemma vangle_eq_zeroD: "vangle u v = 0 ⟹ (∃k. v = k *⇩R u)"
apply (auto simp: vangle_def split: if_splits)
apply (subst (asm) arccos_eq_zero_iff)
apply (auto simp: divide_simps mult_less_0_iff split: if_splits)
apply (metis Real_Vector_Spaces.norm_minus_cancel inner_minus_left minus_le_iff norm_cauchy_schwarz)
apply (metis norm_cauchy_schwarz)
by (metis Cauchy_Schwarz_eq2_iff abs_of_pos inner_commute mult.commute mult_sign_intros(5) zero_less_norm_iff)
lemma less_one_multI:
fixes e x::real
shows "e ≤ 1 ⟹ 0 < x ⟹ x < 1 ⟹ e * x < 1"
by (metis (erased, hide_lams) less_eq_real_def monoid_mult_class.mult.left_neutral
mult_strict_mono zero_less_one)
lemma conemem_expansion_estimate:
fixes u v u' v'::"'a::euclidean_space"
assumes "t ∈ {0 .. pi / 2}"
assumes angle_pos: "0 < vangle u v" "vangle u v < pi / 2"
assumes angle_le: "(vangle u' v') ≤ (vangle u v)"
assumes "norm u = 1" "norm v = 1"
shows "norm (conemem u' v' t) ≥ min (norm u') (norm v') * norm (conemem u v t)"
proof -
define e_pre where "e_pre = min (norm u') (norm v')"
let ?w = "conemem u v"
let ?w' = "conemem u' v'"
have cos_angle_le: "cos (vangle u' v') ≥ cos (vangle u v)"
using angle_pos vangle_bounds
by (auto intro!: cos_monotone_0_pi_le angle_le)
have e_pre_le: "e_pre⇧2 ≤ norm u' * norm v'"
by (auto simp: e_pre_def min_def power2_eq_square intro: mult_left_mono mult_right_mono)
have lt: "0 < 1 + 2 * (u ∙ v) * sin t * cos t"
proof -
have "¦u ∙ v¦ < norm u * norm v"
apply (rule Cauchy_Schwarz_strict_ineq2)
using assms
apply auto
apply (subst (asm) vangle_scaleR_self)+
by (auto simp: split: if_splits)
then have "abs (u ∙ v * sin (2 * t)) < 1"
using assms
apply (auto simp add: abs_mult)
apply (subst mult.commute)
apply (rule less_one_multI)
apply (auto simp add: abs_mult inner_eq_vangle )
by (auto simp: cos_vangle_eq_zero_iff_vangle dest!: ortho_imp_angle_pi_half)
then show ?thesis
by (subst mult.assoc sin_times_cos)+ auto
qed
have le: "0 ≤ 1 + 2 * (u ∙ v) * sin t * cos t"
proof -
have "¦u ∙ v¦ ≤ norm u * norm v"
by (rule Cauchy_Schwarz_ineq2)
then have "abs (u ∙ v * sin (2 * t)) ≤ 1"
by (auto simp add: abs_mult assms intro!: mult_le_one)
then show ?thesis
by (subst mult.assoc sin_times_cos)+ auto
qed
have "(norm (?w t))⇧2 = (cos t)⇧2 *⇩R (norm u)⇧2 + (sin t)⇧2 *⇩R (norm v)⇧2 + 2 * (u ∙ v) * sin t * cos t"
by (auto simp: conemem_def algebra_simps power2_norm_eq_inner)
(auto simp: power2_eq_square inner_commute)
also have "… = 1 + 2 * (u ∙ v) * sin t * cos t"
by (auto simp: sin_squared_eq algebra_simps assms)
finally have "(norm (conemem u v t))⇧2 = 1 + 2 * (u ∙ v) * sin t * cos t" by simp
moreover
have "(norm (?w' t))⇧2 = (cos t)⇧2 *⇩R (norm u')⇧2 + (sin t)⇧2 *⇩R (norm v')⇧2 + 2 * (u' ∙ v') * sin t * cos t"
by (auto simp: conemem_def algebra_simps power2_norm_eq_inner)
(auto simp: power2_eq_square inner_commute)
ultimately
have "(norm (?w' t) / norm (?w t))⇧2 =
((cos t)⇧2 *⇩R (norm u')⇧2 + (sin t)⇧2 *⇩R (norm v')⇧2 + 2 * (u' ∙ v') * sin t * cos t) /
(1 + 2 * (u ∙ v) * sin t * cos t)"
(is "_ = (?a + ?b) / ?c")
by (auto simp: divide_inverse power_mult_distrib) (auto simp: inverse_eq_divide power2_eq_square)
also have "… ≥ (e_pre⇧2 + ?b) / ?c"
apply (rule divide_right_mono)
apply (rule add_right_mono)
subgoal using assms e_pre_def
apply (auto simp: min_def)
subgoal by (auto simp: algebra_simps cos_squared_eq intro!: mult_right_mono power_mono)
subgoal by (auto simp: algebra_simps sin_squared_eq intro!: mult_right_mono power_mono)
done
subgoal by (rule le)
done
also (xtrans)
have inner_nonneg: "u' ∙ v' ≥ 0"
using angle_le(1) angle_pos vangle_bounds[of u' v']
by (auto simp: inner_eq_vangle intro!: mult_nonneg_nonneg cos_ge_zero)
from vangle_bounds[of u' v'] vangle_le_pi2[OF this]
have u'v'e_pre: "u' ∙ v' ≥ cos (vangle u' v') * e_pre⇧2"
apply (subst inner_eq_vangle)
apply (rule mult_left_mono)
apply (rule e_pre_le)
apply (rule cos_ge_zero)
by auto
have "(e_pre⇧2 + ?b) / ?c ≥ (e_pre⇧2 + 2 * (cos (vangle u' v') * e_pre⇧2) * sin t * cos t) / ?c"
(is "_ ≥ ?ddd")
apply (intro divide_right_mono add_left_mono mult_right_mono mult_left_mono u'v'e_pre)
using ‹t ∈ _›
by (auto intro!: mult_right_mono sin_ge_zero divide_right_mono le cos_ge_zero
simp: sin_times_cos u'v'e_pre)
also (xtrans) have "?ddd = e_pre⇧2 * ((1 + 2 * cos (vangle u' v') * sin t * cos t) / ?c)" (is "_ = ?ddd")
by (auto simp add: divide_simps algebra_simps)
also (xtrans)
have sc_ge_0: "0 ≤ sin t * cos t"
using ‹t ∈ _›
by (auto simp: assms cos_angle_le intro!: mult_nonneg_nonneg sin_ge_zero cos_ge_zero)
have "?ddd ≥ e_pre⇧2"
apply (subst mult_le_cancel_left1)
apply (auto simp add: divide_simps split: if_splits)
apply (rule mult_right_mono)
using lt
by (auto simp: assms inner_eq_vangle intro!: mult_right_mono sc_ge_0 cos_angle_le)
finally (xtrans)
have "(norm (conemem u' v' t))⇧2 ≥ (e_pre * norm (conemem u v t))⇧2"
by (simp add: divide_simps power_mult_distrib split: if_splits)
then show "norm (conemem u' v' t) ≥ e_pre * norm (conemem u v t)"
using norm_imp_pos_and_ge power2_le_imp_le by blast
qed
lemma conemem_commute: "conemem a b t = conemem b a (pi / 2 - t)" if "0 ≤ t" "t ≤ pi / 2"
using that by (auto simp: conemem_def cos_sin_eq algebra_simps)
lemma conesegment_commute: "conesegment a b = conesegment b a"
apply (auto simp: conesegment_def )
apply (subst conemem_commute)
apply auto
apply (subst conemem_commute)
apply auto
done
definition "conefield u v = cone hull (conesegment u v)"
lemma conefield_alt_def: "conefield u v = cone hull {u--v}"
apply (auto simp: conesegment_def conefield_def cone_hull_expl in_segment)
subgoal premises prems for c t
proof -
from prems
have sc_pos: "sin t + cos t > 0"
apply (cases "t = 0")
subgoal
by (rule add_nonneg_pos) auto
subgoal
by (auto intro!: add_pos_nonneg sin_gt_zero cos_ge_zero)
done
then have 1: "(sin t / (sin t + cos t) + cos t / (sin t + cos t)) = 1"
by (auto simp: divide_simps)
have "∃c x. c > 0 ∧ 0 ≤ x ∧ x ≤ 1 ∧ c *⇩R conemem u v t = (1 - x) *⇩R u + x *⇩R v"
apply (auto simp: algebra_simps conemem_def)
apply (rule exI[where x="1 / (sin t + cos t)"])
using prems
by (auto intro!: exI[where x="(1 / (sin t + cos t) * sin t)"] sc_pos
divide_nonneg_nonneg sin_ge_zero add_nonneg_nonneg cos_ge_zero
simp: scaleR_add_left[symmetric] 1 divide_le_eq_1)
then obtain d x where dx: "d > 0" "conemem u v t = (1 / d) *⇩R ((1 - x) *⇩R u + x *⇩R v)"
"0 ≤ x" "x ≤ 1"
by (auto simp: eq_vector_fraction_iff)
show ?thesis
apply (rule exI[where x="c / d"])
using dx
by (auto simp: intro!: divide_nonneg_nonneg prems )
qed
subgoal premises prems for c t
proof -
let ?x = "arctan (t / (1 - t))"
let ?s = "t / sin ?x"
have *: "c *⇩R ((1 - t) *⇩R u + t *⇩R v) = (c * ?s) *⇩R (cos ?x *⇩R u + sin ?x *⇩R v)"
if "0 < t" "t < 1"
using that
by (auto simp: scaleR_add_right sin_arctan cos_arctan divide_simps)
show ?thesis
apply (cases "t = 0")
subgoal
apply simp
apply (rule exI[where x=c])
apply (rule exI[where x=u])
using prems
by (auto simp: conemem_def[abs_def] intro!: image_eqI[where x=0])
subgoal apply (cases "t = 1")
subgoal
apply simp
apply (rule exI[where x=c])
apply (rule exI[where x=v])
using prems
by (auto simp: conemem_def[abs_def] intro!: image_eqI[where x="pi/2"])
subgoal
apply (rule exI[where x="(c * ?s)"])
apply (rule exI[where x="(cos ?x *⇩R u + sin ?x *⇩R v)"])
using prems * arctan_ubound[of "t / (1 - t)"]
apply (auto simp: conemem_def[abs_def] intro!: imageI)
by (auto simp: scaleR_add_right sin_arctan)
done
done
qed
done
lemma
bounded_linear_image_cone_hull:
assumes "bounded_linear F"
shows "F ` (cone hull T) = cone hull (F ` T)"
proof -
from assms interpret bounded_linear F .
show ?thesis
apply (auto simp: conefield_def cone_hull_expl closed_segment_def add scaleR)
apply (auto simp: )
apply (auto simp: add[symmetric] scaleR[symmetric])
done
qed
lemma
bounded_linear_image_conefield:
assumes "bounded_linear F"
shows "F ` conefield u v = conefield (F u) (F v)"
unfolding conefield_def
using assms
by (auto simp: bounded_linear_image_conesegment bounded_linear_image_cone_hull)
lemma conefield_commute: "conefield x y = conefield y x"
by (auto simp: conefield_def conesegment_commute)
lemma convex_conefield: "convex (conefield x y)"
by (auto simp: conefield_alt_def convex_cone_hull)
lemma conefield_scaleRI: "v ∈ conefield (r *⇩R x) y" if "v ∈ conefield x y" "r > 0"
using that
using ‹r > 0›
unfolding conefield_alt_def cone_hull_expl
apply (auto simp: in_segment)
proof goal_cases
case (1 c u)
let ?d = "c * (1 - u) / r + c * u"
let ?t = "c * u / ?d"
have "c * (1 - u) = ?d * (1 - ?t) * r" if "0 < u"
using ‹0 < r› that(1) 1(3,5) mult_pos_pos
by (force simp: divide_simps ac_simps ring_distribs[symmetric])
then have eq1: "(c * (1 - u)) *⇩R x = (?d * (1 - ?t) * r) *⇩R x" if "0 < u"
using that by simp
have "c * u = ?d * ?t" if "u < 1"
using ‹0 < r› that(1) 1(3,4,5) mult_pos_pos
apply (auto simp: divide_simps ac_simps ring_distribs[symmetric])
proof -
assume "0 ≤ u"
"0 < r"
"1 - u + r * u = 0"
"u < 1"
then have False
by (sos "((((A<0 * A<1) * R<1) + (([~1*r] * A=0) + ((A<=0 * R<1) * (R<1 * [r]^2)))))")
then show "u = 0"
by metis
qed
then have eq2: "(c * u) *⇩R y = (?d * ?t) *⇩R y" if "u < 1"
using that by simp
have *: "c *⇩R ((1 - u) *⇩R x + u *⇩R y) = ?d *⇩R ((1 - ?t) *⇩R r *⇩R x + ?t *⇩R y)"
if "0 < u" "u < 1"
using that eq1 eq2
by (auto simp: algebra_simps)
show ?case
apply (cases "u = 0")
subgoal using 1 by (intro exI[where x="c / r"] exI[where x="r *⇩R x"]) auto
apply (cases "u = 1")
subgoal using 1 by (intro exI[where x="c"] exI[where x="y"]) (auto intro!: exI[where x=1])
subgoal
apply (rule exI[where x="?d"])
apply (rule exI[where x="((1 - ?t) *⇩R r *⇩R x + ?t *⇩R y)"])
apply (subst *)
using 1
apply (auto intro!: exI[where x = ?t])
apply (auto simp: algebra_simps divide_simps)
defer
proof -
assume a1: "c + c * (r * u) < c * u"
assume a2: "0 ≤ c"
assume a3: "0 ≤ u"
assume a4: "u ≠ 0"
assume a5: "0 < r"
have "c + c * (r * u) ≤ c * u"
using a1 less_eq_real_def by blast
then show "c ≤ c * u"
using a5 a4 a3 a2 by (metis (no_types) less_add_same_cancel1 less_eq_real_def
mult_pos_pos order_trans real_scaleR_def real_vector.scale_zero_left)
next
assume a1: "0 ≤ c"
assume a2: "u ≤ 1"
have f3: "∀x0. ((x0::real) < 1) = (¬ 1 ≤ x0)"
by auto
have f4: "∀x0. ((1::real) < x0) = (¬ x0 ≤ 1)"
by fastforce
have "∀x0 x1. ((x1::real) < x1 * x0) = (¬ 0 ≤ x1 + - 1 * (x1 * x0))"
by auto
then have "(∀r ra. ((r::real) < r * ra) = ((0 ≤ r ⟶ 1 < ra) ∧ (r ≤ 0 ⟶ ra < 1))) = (∀r ra. (¬ (0::real) ≤ r + - 1 * (r * ra)) = ((¬ 0 ≤ r ∨ ¬ ra ≤ 1) ∧ (¬ r ≤ 0 ∨ ¬ 1 ≤ ra)))"
using f4 f3 by presburger
then have "0 ≤ c + - 1 * (c * u)"
using a2 a1 mult_less_cancel_left1 by blast
then show "c * u ≤ c"
by auto
qed
done
qed
lemma conefield_scaleRD: "v ∈ conefield x y" if "v ∈ conefield (r *⇩R x) y" "r > 0"
using conefield_scaleRI[OF that(1) positive_imp_inverse_positive[OF that(2)]] that(2)
by auto
lemma conefield_scaleR: "conefield (r *⇩R x) y = conefield x y" if "r > 0"
using conefield_scaleRD conefield_scaleRI that
by blast
lemma conefield_expansion_estimate:
fixes u v::"'a::euclidean_space" and F::"'a ⇒ 'a"
assumes "t ∈ {0 .. pi / 2}"
assumes angle_pos: "0 < vangle u v" "vangle u v < pi / 2"
assumes angle_le: "vangle (F u) (F v) ≤ vangle u v"
assumes "bounded_linear F"
assumes "x ∈ conefield u v"
shows "norm (F x) ≥ min (norm (F u)/norm u) (norm (F v)/norm v) * norm x"
proof cases
assume [simp]: "x ≠ 0"
from assms have [simp]: "u ≠ 0" "v ≠ 0" by auto
interpret bounded_linear F by fact
define u1 where "u1 = u /⇩R norm u"
define v1 where "v1 = v /⇩R norm v"
note ‹x ∈ conefield u v›
also have ‹conefield u v = conefield u1 v1›
by (auto simp: u1_def v1_def conefield_scaleR conefield_commute[of u])
finally obtain c t where x: "x = c *⇩R conemem u1 v1 t" "t ∈ {0 .. pi / 2}" "c ≥ 0"
by (auto simp: conefield_def cone_hull_expl conesegment_def)
then have xc: "x /⇩R c = conemem u1 v1 t"
by (auto simp: divide_simps)
also have "F … = conemem (F u1) (F v1) t"
by (simp add: bounded_linear_image_conemem assms)
also have "norm … ≥ min (norm (F u1)) (norm (F v1)) * norm (conemem u1 v1 t)"
apply (rule conemem_expansion_estimate)
subgoal by fact
subgoal using angle_pos by (simp add: u1_def v1_def vangle_scaleR)
subgoal using angle_pos by (simp add: u1_def v1_def vangle_scaleR)
subgoal using angle_le by (simp add: u1_def v1_def scaleR vangle_scaleR)
subgoal using angle_le by (simp add: u1_def v1_def scaleR vangle_scaleR)
subgoal using angle_le by (simp add: u1_def v1_def scaleR vangle_scaleR)
done
finally show "norm (F x) ≥ min (norm (F u)/norm u) (norm (F v)/norm v) * norm x"
unfolding xc[symmetric] scaleR u1_def v1_def norm_scaleR x
using ‹c ≥ 0›
by (simp add: divide_simps split: if_splits)
qed simp
lemma conefield_rightI:
assumes ij: "i ∈ Basis" "j ∈ Basis" and ij_neq: "i ≠ j"
assumes "y ∈ {y1 .. y2}"
shows "(i + y *⇩R j) ∈ conefield (i + y1 *⇩R j) (i + y2 *⇩R j)"
unfolding conefield_alt_def
apply (rule hull_inc)
using assms
by (auto simp: in_segment divide_simps inner_Basis algebra_simps
intro!: exI[where x="(y - y1) / (y2 - y1)"] euclidean_eqI[where 'a='a] )
lemma conefield_right_vangleI:
assumes ij: "i ∈ Basis" "j ∈ Basis" and ij_neq: "i ≠ j"
assumes "y ∈ {y1 .. y2}" "y1 < y2"
shows "(i + y *⇩R j) ∈ conefield (i + y1 *⇩R j) (i + y2 *⇩R j)"
unfolding conefield_alt_def
apply (rule hull_inc)
using assms
by (auto simp: in_segment divide_simps inner_Basis algebra_simps
intro!: exI[where x="(y - y1) / (y2 - y1)"] euclidean_eqI[where 'a='a] )
lemma cone_conefield[intro, simp]: "cone (conefield x y)"
unfolding conefield_def
by (rule cone_cone_hull)
lemma conefield_mk_rightI:
assumes ij: "i ∈ Basis" "j ∈ Basis" and ij_neq: "i ≠ j"
assumes "(i + (y / x) *⇩R j) ∈ conefield (i + (y1 / x1) *⇩R j) (i + (y2 / x2) *⇩R j)"
assumes "x > 0" "x1 > 0" "x2 > 0"
shows "(x *⇩R i + y *⇩R j) ∈ conefield (x1 *⇩R i + y1 *⇩R j) (x2 *⇩R i + y2 *⇩R j)"
proof -
have rescale: "(x *⇩R i + y *⇩R j) = x *⇩R (i + (y / x) *⇩R j)" if "x > 0" for x y
using that by (auto simp: algebra_simps)
show ?thesis
unfolding rescale[OF ‹x > 0›] rescale[OF ‹x1 > 0›] rescale[OF ‹x2 > 0›]
conefield_scaleR[OF ‹x1 > 0›]
apply (subst conefield_commute)
unfolding conefield_scaleR[OF ‹x2 > 0›]
apply (rule mem_cone)
apply simp
apply (subst conefield_commute)
by (auto intro!: assms less_imp_le)
qed
lemma conefield_prod3I:
assumes "x > 0" "x1 > 0" "x2 > 0"
assumes "y1 / x1 ≤ y / x" "y / x ≤ y2 / x2"
shows "(x, y, 0) ∈ (conefield (x1, y1, 0) (x2, y2, 0)::(real*real*real) set)"
proof -
have "(x *⇩R (1, 0, 0) + y *⇩R (0, 1, 0)) ∈
(conefield (x1 *⇩R (1, 0, 0) + y1 *⇩R (0, 1, 0)) (x2 *⇩R (1, 0, 0) + y2 *⇩R (0, 1, 0))::(real*real*real) set)"
apply (rule conefield_mk_rightI)
subgoal by (auto simp: Basis_prod_def zero_prod_def)
subgoal by (auto simp: Basis_prod_def zero_prod_def)
subgoal by (auto simp: Basis_prod_def zero_prod_def)
subgoal using assms by (intro conefield_rightI) (auto simp: Basis_prod_def zero_prod_def)
by (auto intro: assms)
then show ?thesis by simp
qed
end
Theory Linear_ODE
section ‹Linear ODE›
theory Linear_ODE
imports
"../IVP/Flow"
Bounded_Linear_Operator
Multivariate_Taylor
begin
lemma
exp_scaleR_has_derivative_right[derivative_intros]:
fixes f::"real ⇒ real"
assumes "(f has_derivative f') (at x within s)"
shows "((λx. exp (f x *⇩R A)) has_derivative (λh. f' h *⇩R (exp (f x *⇩R A) * A))) (at x within s)"
proof -
from assms have "bounded_linear f'" by auto
with real_bounded_linear obtain m where f': "f' = (λh. h * m)" by blast
show ?thesis
using vector_diff_chain_within[OF _ exp_scaleR_has_vector_derivative_right, of f m x s A] assms f'
by (auto simp: has_vector_derivative_def o_def)
qed
context
fixes A::"'a::{banach,perfect_space} blinop"
begin
definition "linode_solution t0 x0 = (λt. exp ((t - t0) *⇩R A) x0)"
lemma linode_solution_solves_ode:
"(linode_solution t0 x0 solves_ode (λ_. A)) UNIV UNIV" "linode_solution t0 x0 t0 = x0"
by (auto intro!: solves_odeI derivative_eq_intros
simp: has_vector_derivative_def blinop.bilinear_simps exp_times_scaleR_commute
has_vderiv_on_def linode_solution_def)
lemma "(linode_solution t0 x0 usolves_ode (λ_. A) from t0) UNIV UNIV"
using linode_solution_solves_ode(1)
proof (rule usolves_odeI)
fix s t1
assume s0: "s t0 = linode_solution t0 x0 t0"
assume sol: "(s solves_ode (λx. blinop_apply A)) {t0--t1} UNIV"
then have [derivative_intros]:
"(s has_derivative (λh. h *⇩R A (s t))) (at t within {t0 -- t1})" if "t ∈ {t0 -- t1}" for t
using that
by (auto dest!: solves_odeD(1) simp: has_vector_derivative_def has_vderiv_on_def)
have "((λt. exp (-(t - t0) *⇩R A) (s t)) has_derivative (λ_. 0)) (at t within {t0 -- t1})"
(is "(?es has_derivative _) _")
if "t ∈ {t0 -- t1}" for t
by (auto intro!: derivative_eq_intros that simp: has_vector_derivative_def
blinop.bilinear_simps)
from has_derivative_zero_constant[OF convex_closed_segment this]
obtain c where c: "⋀t. t ∈ {t0 -- t1} ⟹ ?es t = c" by auto
hence "(exp ((t - t0) *⇩R A) * (exp (-((t - t0) *⇩R A)))) (s t) = exp ((t - t0) *⇩R A) c"
if "t ∈ {t0 -- t1}" for t
by (metis (no_types, hide_lams) blinop_apply_times_blinop real_vector.scale_minus_left that)
then have s_def: "s t = exp ((t - t0) *⇩R A) c" if "t ∈ {t0 -- t1}" for t
by (simp add: exp_minus_inverse that)
from s0 s_def
have "exp ((t0 - t0) *⇩R A) c = x0"
by (simp add: linode_solution_solves_ode(2))
hence "c = x0" by (simp add: )
then show "s t1 = linode_solution t0 x0 t1"
using s_def[of t1] by (simp add: linode_solution_def)
qed auto
end
end